XCOPY: Is it possible that the source folder contains the destination folder? - vba

I want to copy a folder with xcopy. However, as soon as I place the destination folder in the source folder, nothing is being copied anymore. Is there a workaround for this problem?
The idea is to generate a backup of an entire folder strucutre (source) into one subfolder. When executing xcopy I exclude the subfolder for the backup (destination), where my backups should be stored.
I have already tested my code and it works just fine as long as the destination folder does no lie within the source folder.
The code is written with VBA.
Function CopyFolder(ByVal sourcePath As String, ByVal destinationPath As String, ByVal excludeFile As String)
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
' /e -> copys all subfolders including empty ones; /k -> retains the read-only attribute if existend
wsh.Run "xcopy " & sourcePath & " " & destinationPath & " /e /k /exclude:" & excludeFile, vbNormalFocus, waitOnReturn
End Function
The code is being executed with no error, but when I check the destination folder, no files haven been copied.

this should not be possible since it should end with the error: "unable to execute a cyclic copy" or stuff like that.
if you want you can do something like this (one-liner):
FOR /F "usebackq delims=;" %A IN (`dir %sourcePath% /B /AD ^|FINDSTR /V "%destinationPath%"`) DO #xcopy "%sourcePath%\%A\*.*" "%destinationPath%\" /EK
if the SOURCE is filled with directories that you should copy in the DEST. subdirectory with all their files.
Pay Attention to:
... %A IN (**`** .... **`**) <---- theese are reverse quotes (alt+96)
... /AD **^**|FINDSTR /V <---- this CAP has to be written explicitly like this (but without asterisks, obvious)
%sourcePath% and %destinationPath% <--- This is the batch variable notation. Do your String concatenation magic here, since you're launching from inside a vba
Hope this helps you! :-)
Bye

Related

VBA FileExists and Sharepoint

I'm running into issues trying to pull info from files stored in Sharepoint.
Namely, FileExists isn't working and Overwrite file doesn't seem to be working either.
There was a discussion here, but few answers -> posting this question again in hopes some things have changed
My code runs like this:
strFileExists = Dir(Filepath & Filename)
And returns: File path not found -> I checked the path and even opened a file and recorded the macro to make sure it was the same file path without issue, but it appears DIR() is the issue.
The business dept I'm working with is entirely switching over to Sharepoint so hoping there's a straightforward solution without setting up network shares or doing C/personal/OneDrive things
You can navigate and look for files on OneDrive like this
Sub check_File_Exists()
Dim path As String
Dim strType As String
Dim file As Variant
Dim yourFile As String
'replace uname with your user name
path = "C:\Users\uname\OneDrive\"
strType = "*txt"
yourFile = "test.txt"
file = Dir(path & strType)
Do While (file <> "")
If file = yourFile Then
Debug.Print ("File: " & file & " found!")
Exit Do
End If
file = Dir
Loop
End Sub
Hope it helps

How to copy a Folder Iterative in vb.net

i created a program that copies folders + content into a different location, but this doesn't work with Folders in sizes i work with (50GB). I currently have a recursive function but it seems that this exceeds the memory limits. The only solution I could think of by now was a CMD call like.
process.start("cmd", "/C xcopy /E /V /I /Y """ & srcfld & """ """ & targfld & """")
Please excuse my variable-names, I'm lazy when it comes to typing names.
EDIT: The requested function:
Public Sub ordkop(ByVal srcfld As String, ByVal targfld As String)
Directory.CreateDirectory(targfld)
Dim files() As String
files = Directory.GetFileSystemEntries(srcfld)
For Each element As String In files
If Directory.Exists(element) Then
CopyDir(element, Path.Combine(targfld, Path.GetFileName(element)))
Else
File.Copy(element, Path.Combine(targfld, Path.GetFileName(element)), True)
End If
Next
End Sub

How can I find the installation directory of a specific program?

I have successfully coded some VBA macros for work which basically create a data file, feed it to a program and post-treat the output from this program.
My issue is that the program installation path is hard coded in the macro and the installation may vary accross my colleagues computers.
The first thing I thought is that I can gather from everyone the different installation directories and test for all of them in the code. Hopefully, one of them will work. But it doesn't feel that clean.
So my other idea was to somehow get the installation directory in the code. I thought it would be possible as in Windows, if I right click on a shortcut, I can ask to open the file's directory. What I'm basically looking for is an equivalent in VBA of this right click action in Windows. And that's where I'm stuck.
From what I found, Windows API may get the job done but that's really out of what I know about VBA.
The API FindExecutable seemed not too far from what I wanted but I still can't manage to use it right. So far, I can only get the program running if I already know its directory.
Could you give me some pointers ? Thanks.
Here's another method for you to try. Note that you might see a black box pop up for a moment, that's normal.
Function GetInstallDirectory(appName As String) As String
Dim retVal As String
retVal = Split(CreateObject("WScript.Shell").Exec("CMD /C FOR /r ""C:\"" %i IN (*" & appName & ") DO (ECHO %i)").StdOut.ReadAll, vbCrLf)(2)
GetInstallDirectory = Left$(retVal, InStrRev(retVal, "\"))
End Function
It's not as clean as using API but should get the trick done.
Summary:
retVal = Split(CreateObject("WScript.Shell").Exec("CMD /C FOR /r ""C:\"" %i IN (*" & appName & ") DO (ECHO %i)").StdOut.ReadAll, vbCrLf)(1)
"CMD /C FOR /r ""C:\"" %i IN (*" & appName & ") DO (ECHO %i)" is a command that works in CMD to loop through files rooted at a defined path. We use the wildcard with the appName variable to test for the program we want. (more info on FOR /R here) Here, we have created the CMD application using a Shell object (WScript.Shell) and Executed the command prompt CMD passing arguments to it directly after. The /C switch means that we want to pass a command to CMD and then close the window immediately after it's processed.
We then use .StdOut.ReadAll to read all of the output from that command via the Standard Output stream.
Next, we wrap that in a Split() method and split the output on vbCrLf (Carriage return & Line feed) so that we have a single dimension array with each line of the output. Because the command outputs each hit on a new line in CMD this is ideal.
The output looks something like this:
C:\Users\MM\Documents>(ECHO C:\Program Files\Microsoft
Office\Office14\EXCEL.EXE ) C:\Program Files\Microsoft
Office\Office14\EXCEL.EXE
C:\Users\MM\Documents>(ECHO
C:\Windows\Installer\$PatchCache$\Managed\00004109110000000000000000F01FEC\14.0.4763\EXCEL.EXE
)
C:\Windows\Installer\$PatchCache$\Managed\00004109110000000000000000F01FEC\14.0.4763\EXCEL.EXE
C:\Users\olearysa\Documents>(ECHO
C:\Windows\Installer\$PatchCache$\Managed\00004109110000000000000000F01FEC\14.0.7015\EXCEL.EXE
)
C:\Windows\Installer\$PatchCache$\Managed\00004109110000000000000000F01FEC\14.0.7015\EXCEL.EXE
We're only interested in the third line of the output (the first line is actually blank), so we can access that index of the array directly by using (2) after it (because arrays are zero-indexed by default)
Finally, we only want the path so we use a combination of Left$() (which will return n amount of characters from the left of a string) and InStrRev() (which returns the position of a substring starting from the end and moving backwards). This means we can specify everything from the left until the first occurrence of \ when searching backwards through the string.
Give this a try, assuming you know the name of the .exe:
#If Win64 Then
Declare PtrSafe Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
#Else
Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
#End If
Const SYS_OUT_OF_MEM As Long = &H0
Const ERROR_FILE_NOT_FOUND As Long = &H2
Const ERROR_PATH_NOT_FOUND As Long = &H3
Const ERROR_BAD_FORMAT As Long = &HB
Const NO_ASSOC_FILE As Long = &H1F
Const MIN_SUCCESS_LNG As Long = &H20
Const MAX_PATH As Long = &H104
Const USR_NULL As String = "NULL"
Const S_DIR As String = "C:\" '// Change as required (drive that .exe will be on)
Function GetInstallDirectory(ByVal usProgName As String) As String
Dim fRetPath As String * MAX_PATH
Dim fRetLng As Long
fRetLng = FindExecutable(usProgName, S_DIR, fRetPath)
If fRetLng >= MIN_SUCCESS_LNG Then
GetInstallDirectory = Left$(Trim$(fRetPath), InStrRev(Trim$(fRetPath), "\"))
End If
End Function
Example of how to use, let's try looking for Excel:
Sub ExampleUse()
Dim x As String
x = "EXCEL.EXE"
Debug.Print GetInstallDirectory(x)
End Sub
Output (on my machine anyway) is
C:\Program Files\Microsoft Office\Office14\
Assuming you are working on PC only and the people are working with their own copies and not a shared network copy. I would recommend the following.
Create a Sheet called 'Config', place the path with the exe in there, and then hide it.
Use use FileScriptingObject ('Tools' > 'References' > 'Microsoft Scripting Runtime') to see if the path in 'Config' exists
If it does not, ask the user for the location using a 'open file dialog box' and remember that in the 'Config' Sheet for next time.
The below code may help as a pointer.
Dim FSO As New FileSystemObject
Private Function GetFilePath() As String
Dim FlDlg As FileDialog
Dim StrPath As String
Set FlDlg = Application.FileDialog(msoFileDialogOpen)
With FlDlg
.Filters.Clear
.Filters.Add "Executable Files", "*.exe"
.AllowMultiSelect = False
.ButtonName = "Select"
.Title = "Select the executable"
.Show
If .SelectedItems.Count <> 0 Then GetFilePath = .SelectedItems(1)
End With
Set FlDlg = Nothing
End Function
Private Function FileExists(ByVal StrPath As String) As Boolean
FileExists = FSO.FileExists(StrPath)
End Function

How can I run more then too commands with WScript.Shell object?

I'm using below macro in goal of obtaining list of all files in folder :
Sub SO()
Const parentFolder As String = "C:\Users\bloggsj\folder\" '// change as required, keep trailing slash
Dim results As String
results = CreateObject("WScript.Shell").Exec("CMD /C DIR """ & parentFolder & "*.*"" /S /B /A:-D").StdOut.ReadAll
Debug.Print results
Ens Sub
but it gives me invalid output as it doesn't chandle Unicode characters, which are part of files names in my directory. In normal batch file I could use additional command 'CHCP 1250' to change coding page for symbols. But I can't incorpotrate it into above macro. I've tried in several ways like :
results = CreateObject("WScript.Shell").Exec("CMD /C CHCP 1250 DIR """ & parentFolder & "*.*"" /S /B /A:-D").StdOut.ReadAll
and
results = CreateObject("WScript.Shell").Exec("CMD /C ""CHCP 1250"" ""DIR """ & parentFolder & "*.*"" /S /B /A:-D""").StdOut.ReadAll
Ampersand
command1 & command2 : Use to separate multiple commands on one command
line. Cmd.exe runs the first command, and then the second command.
CMD /C CHCP 1250 & DIR ....
However VBA has native support for a directory listing and VBScript can use the FileSystemObject to achieve the same.

FileCopy gives Error 53 File Not Found

The Problem:
As stated above, I have a line of code, FileCopy String5, String6, that is giving Error 53: File Not Found. I have determined that the error is occurring with String6. I need another pair of eyes to help me find the error.
What I've Tried:
Printing String6 to a cell to make sure it is correct
Copying String6 into Windows Explorer and Windows-->Run (after deleting the file name, it hasn't been created yet due to the macro error) to make sure they open the folder correctly
Used Dir function to double check that Excel can see the copyto directory after I've made it
Because the files about to be copied come from a folder that was unzipped prior to the code, adding a 1 second wait in case the new files somehow hadn't been detected (basically trying everything now)
I'm open to any suggestions. Here's an updated section of my code in case it helps, and I'd be happy to post the whole thing as well:
'File Manipulation
'Find a file in StrDir1 with String2 extension, "*.dat"
String4 = Dir(StrDir1 & String2)
Do While String4 <> ""
'Save the complete path of the file found
String5 = StrDir1 & String4
For Loop1 = LBound(Array1) To UBound(Array1)
'Array1 has file identifiers in it that identify who the file belongs to for later separation and folder placement
If InStr(String5, Array1(Loop1)) Then
'We found a file with the identifier, save the future complete path of the copied file
String6 = StrDir1 & Array2(Loop1) & String4
'Create the containing folder where the file will be copied if it does not already exist
String10 = vbNullString
On Error Resume Next
'Check if the folder already exists
String10 = Dir(StrDir1 & Array2(Loop1), vbDirectory)
On Error GoTo 0
'If it doesn't exist, create it
If String10 = vbNullString Then
MkDir StrDir1 & Array2(Loop1)
End If
'String8 is the file type, it was determined earlier
If String8 = "997" Then
String7 = "\\(directory)\" & String4
'This works, which makes me think the problem is String6.
Object2.CopyFile String5, String7
'For testing purposes
ThisWorkbook.Sheets(1).Cells(1, 1).Value = String5
ThisWorkbook.Sheets(1).Cells(2, 1).Value = String6
String10 = Dir(StrDir1 & Array2(Loop1), vbDirectory)
'Back to the real code
'When these lines are commented, Error 53, file not found. When uncommented, Error 76, path not found.
' String5 = " & String5 & "
' String6 = " & String6 & "
'Error occurs here
Object2.CopyFile String5, String6
Kill String5
String4 = Dir(StrDir1 & String2)
'code continues
To reiterate, the error occurs on the Object2.CopyFile String5, String6 line of the above code.
Here are String5 and String6 at the time of error, in case it helps anyone. These values are copied from Cells 1,1 and 2,1:
String5: \\extremely long directory\extremely long file name.ext
String6: \\extremely long directory\extremely long file name.ext
Update: I switched to fso.copyfile and I also tried adding quotes around my strings to avoid any problems with the directories containing spaces. When I added quotes, the error changed to Error 76, path not found. Does this help troubleshoot my code?
(I also added a few more lines to my code snippet to hopefully demonstrate this isn't a Dir() problem to the best of my knowledge, but since I am new to Dir(), Tim could still be right.)
Update 2: I think String6 is too long. I'm using the following code to test but Excel keeps crashing after successfully copying the file when I try to run it. Is there something I need to know about FSO to prevent that?
Sub M2Pathtester()
Dim String5 As String
Dim String6 As String
Dim Object2 As Object
Set Object2 = CreateObject("scripting.filesystemobject")
String5 = ThisWorkbook.Sheets(1).Cells(1, 1)
String6 = ThisWorkbook.Sheets(1).Cells(2, 1)
Object2.CopyFile String5, String6
End Sub
Final Update:
Yes, the string was too long. Excel still repeatedly crashes (after successfully copying) using the fso.copyfile method, but when I reverted back to FileCopy, it worked smoothly.
I don't see any obvious reason that you should be getting an error 53 for the destination file. Some sources indicate that FileCopy can be quirky with spaces in the path, but that really should be giving an error 52 if that's the case. I found one other report of somebody claiming that they needed to stop hiding know file extensions in the destination folder to avoid an error with FileCopy, but I'm not sure I'm buying that one.
I'd make sure that you have the appropriate permissions in the folder you're writing to, and use the Scripting.FilesystemObject to perform the copy instead - it's typically more robust:
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile String5, String6
The answer was that String6 exceeded the maximum character length. So be warned that that is a possibility when getting Error 53 or Error 76 when using FileCopy or fso.copyfile.
Note: Because of my inexperience with FSO, this might not be exactly/technically correct, but I hope it informs you enough to get you on the right path if you're stuck.