Saving file in users document folder using Environ

[emhotep]

Hi guys

I have tried for weeks to automate my macro.

I have a macro and I want to integrate the following (not to make a new macro):

I want to check if a specific folder exist and if not create 3 folders.
I want to do this regardless of the computer I do it on!

If anyone can help me to crerate thye lines I need to use Environ kindly do so.

I got it to actually make the folders but not to save the files using:

Code: Select all

Sub Dircheck()
    Dim MyFilePath As String
    MyFilePath = Environ$("documents") & "\"
Application.ScreenUpdating = True
If Len(Dir("TenisProgram\BackupIndividuales", vbDirectory)) = 0 Then
MkDir "TenisProgram"
MkDir "TenisProgram\BackupIndividuales"
MkDir "TenisProgram\BackupDobles"
End If



The specific macro look like this (some removed):

Code: Select all

Private Sub CommandBotton1_Click()

Application.ScreenUpdating = False
 
ActiveWorkbook.save
 
   Dim OutApp As Object
   Dim OutMail As Object

   Set OutApp = CreateObject("Outlook.Application")
   Set OutMail = OutApp.CreateItem(0)

   On Error Resume Next
   With OutMail
      .To = "tom@myemailaddress.com"
      .CC = ""
      .BCC = ""
      .Subject = "Full copy Liga Gil"
      .Body = "This is a full copy of Liga Gil program end of month - Individuales."
      .Attachments.Add ActiveWorkbook.FullName
      .Send
     End With
    On Error GoTo 0

   Set OutMail = Nothing
   Set OutApp = Nothing

Dim TestStr As String

TestStr = Format(Now, "dd-mmmm-yyyy_Hh.Nn")

Application.DisplayAlerts = False

ActiveWorkbook.SaveCopyAs FileName:="C:\Documents and Settings\Usuario\Mis documentos\TenisProgram\BackupIndividuales\" & TestStr & "_" & ActiveWorkbook.Name
 
ActiveWorkbook.save

Application.DisplayAlerts = True
   
    Dim Response As VbMsgBoxResult
    Response = MsgBox("Reiniciar Puntuación Individuales?", vbQuestion + vbYesNo)
    If Response = vbNo Then Exit Sub

' The rest is removed!!!
  End Sub



I hope that there is an VBA expert in here that can give me a hand.

Thank you all for great forum posts.

Kind regards

Tom

[Don]

Hi and welcome to the forum Tom!

I can't find the directory check code or a reference to it in the second macro that you included.

But, the main thing to do if you want to save a file into the new folders is to make sure that you include the entire file path to the new location when performing a saveas in Excel vba, which it looks like you might do.

But, you should also include the full file or directory path when creating the new directory because, otherwise, it will just be relative to the location of the file from which you are running the macro.

So, instead of using this as a folder path in the first macro:

Code: Select all

TenisProgram\BackupIndividuales

try this:

Code: Select all

C:\Documents and Settings\Usuario\Mis documentos\TenisProgram\BackupIndividuales\

hth!

[emhotep]

Hi Don , nive new page you guys have here.

The whole idea is NOT having to type the full path!

I know my english is not great but I really though that that part was clear.

The program will be installed on different computers and it is a hassle if I have to change 13 macros everytime!

Therefore I wanted to use the Environ$ command so that I can make directories and save files to the actual users "My document" folder.

therefore the %HOMEDRIVE%%HOMEPATH% & "\Documents"

or the Environ$("documents") & "\"

I know it is possible as I have seen several pages describing it but they are very complex and all examples are for NEW macros, not as part of an existing Macro.

Yes, you are correct, I am not an VBA expert, I just read a lot of pages to get the job done

I still hope that there is an expert in here that knows exatly how the commend looks like

Kind regards

Tom

[Don]

Oh ok, I see what you are saying now. I'll see what I can find!

[Don]

Try putting this code into a module and see if it works for you:

Code: Select all

Function UserProfile() As String
    UserProfile = Environ("userprofile") & "\My Documents"
End Function

Sub test()
MsgBox UserProfile()
End Sub

Run the test() macro and it should return the location to the My Documents folder. Once you get it working on it's own, then try implementing it into your code.

hth!

[emhotep]

Hi Don and thank you

Yes, it does the job, however I cannot get it working as part of the path like:

mkdir ("UserProfile" & "TennisProgram")
nor
mkdir ("UserProfile\TennisProgram")
nor
mkdir ("UserProfile" \ "TennisProgram")

Or in any other way I tried
It does check for the directory ok, but when it is not there and I need to create 3 directories is when it all stops....
I know that I have to create thgem one by one.
I need to create:
TenisPrograme
TenisPrograme\Backup Singles
TenisProgram\backup Doubles

I have not given up, so lets see what tomorrow brings, it is now 1am and I am off to bed.

Thank you again

Tom

[Sisyphus]

Hi,

Code: Select all

Private Function UserProfile() As String
    UserProfile = Environ("userprofile") & "\My Documents"
End Function

worked / didn't work with me, either.
I.e. the function returns the path of My Documents but I can't create a folder there using MkDir.

In my case the reason is that "My Documents" aren't kept at the default location (Windows 7). I have them in Drive D whereas Environ() seems to think they are in drive C. As a result MkDir fails. I had UserProfile() return the location of "Desktop" and had no problem creating a folder there using MkDir.
Of course, the Application.PathSeparator is necessary.

So, perhaps the way to go should be to check the path returned by UserProfile("My Documents") and look for another location to put the new folders if that turns up empty. Perhaps Excel's

Code: Select all

Application.DefaultFilePath

is the more reliables choice for getting at an existing directory that is popular with the user. Excel will set this property to "My Documents" by default.

[emhotep]

Hi all and thank you very much for your efforts.
I simply cannot get the Environ command to work correct.
If anyone finds a way since it looks much simpler than the solution I found, it will be appreciated.
Here is the way I got it to work:

Code: Select all

#If VBA7 Then
'64 bit system
    Private Declare PtrSafe Function SHGetSpecialFolderLocation Lib "shell32.dll" _
                        (ByVal hwndOwner As Long, ByVal nFolder As Long, _
                         pidl As ITEMIDLIST) As Long
    Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
                        (ByVal pidl As Long, ByVal pszPath As String) As Long
#Else
'32 bit system
    Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
                        (ByVal hwndOwner As Long, ByVal nFolder As Long, _
                         pidl As ITEMIDLIST) As Long
    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
                        (ByVal pidl As Long, ByVal pszPath As String) As Long
#End If

Private Type SHITEMID
    cb As Long
    abID As Byte
End Type
Private Type ITEMIDLIST
    mkid As SHITEMID
End Type
Private Const CSIDL_PERSONAL As Long = &H5


Public Function GetDocumentsFolder() As String
    Dim lRet As Long, IDL As ITEMIDLIST, sPath As String
    lRet = SHGetSpecialFolderLocation(100&, CSIDL_PERSONAL, IDL)
    If lRet = 0 Then
        sPath = String$(512, Chr$(0))
        lRet = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
        GetDocumentsFolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
    Else
        GetDocumentsFolder = vbNullString
    End If
End Function


Sub OpretFolder()

MyDocumentsFolder = GetDocumentsFolder()

 CreateThisSubFolder = InputBox("Enter name of folder to be created" & MyDocumentsFolder, "Create folder")
 
 If (Dir(MyDocumentsFolder & "\" & CreateThisSubFolder, vbDirectory) = "") Then
    MkDir MyDocumentsFolder & "\" & CreateThisSubFolder
  Else
    MsgBox "Subfolder " & CreateThisSubFolder & " Already exist under " & MyDocumentsFolder
  End If

End Sub



[Sisyphus]

Hi,
What did you find wrong with my suggestion?

Application.DefaultFilePath

After my example showed that ENVIRON can't do the job reliably - at least not, if you send your schedule to me - I don't see the point in trying to make it work. It can't, even if it does.