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
Related
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
How to change or remove attribute of selected folder including all sub folders & files.
I used the following code :
System.IO.SetAttribute(FolderBrowserDialog1.SelectedPath,IO.FileAttribute.Hidden)
But it changes only selected folder attributes not sub folders & files
All subfolders and files can be enumerated like this:
If FolderBrowserDialog1.ShowDialog = DialogResult.OK Then
Dim di = New IO.DirectoryInfo(FolderBrowserDialog1.SelectedPath)
di.Attributes = di.Attributes Or FileAttributes.Hidden
For Each i In di.EnumerateFileSystemInfos("*", SearchOption.AllDirectories)
i.Attributes = i.Attributes Or FileAttributes.Hidden
Next
End If
Another way can be with attrib.exe:
Dim cmd = "attrib +H """ & FolderBrowserDialog1.SelectedPath.TrimEnd("\"c)
Shell("cmd /c " & cmd & """ & " & cmd & "\*"" /S /D", AppWinStyle.Hide)
I expect it to be faster than enumerating all file entries and getting and setting the attributes of each one separately, but another advantage of this method is that by default the shell function does not wait for the command to complete and your program can continue without waiting.
You can loop over subfolder recursively. I think that OS do that recursively too!!
Private Function getAllFolders(ByVal directory As String) As List(of String)
'Create object
Dim fi As New IO.DirectoryInfo(directory)
'Change main folder attribute
System.IO.SetAttribute(directory,IO.FileAttribute.Hidden )
'List to store paths
Dim Folders As New List(Of String)
'Loop through subfolders
For Each subfolder As IO.DirectoryInfo In fi.GetDirectories()
'Add this folders name
Folders.Add(subfolder.FullName)
'Recall function with each subdirectory
For Each s As String In getAllFolders(subfolder.FullName)
Folders.Add(s)
'Change subfolders attribute
System.IO.SetAttribute(s,IO.FileAttribute.Hidden )
Next
Next
Return Folders
End Function
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
I would like to convert images downloaded from the internet[1] to JPGs with ImageMagick in VBA. So far, I've attempted two methods that have both failed.
First, I tried using the ImageMagickObject 1.0 Type Library:
Private Sub CommandButtonOkay_Click()
Dim sURL As String, sNetFile As String, sLocalFile As String, _
cmd As String, RetVal As Integer, img As Object
Set img = New ImageMagickObject.MagickImage
sURL = UserForm1.TextBoxImgURL
sLocalFile = "C:\temp\" & UserForm1.TextBoxName
DownloadFile sURL, sLocalFile ' Function to download image from a URL and save it to a local directory
RetVal = img.Convert(sLocalFile, sLocalFile & ".jpg") '<-- This line produces the error
UserForm1.Hide
End Sub
This ends up giving me the following error:
The source file ("C:\temp\image") exists, but the file that was to be created ("C\temp\image.jpg") does not. This is very similar to the question posted here, but I have not been able to find a solution to that so far.
Second, I tried just calling ImageMagick using the Shell command:
Private Sub CommandButtonOkay_Click()
Dim sURL As String, sNetFile As String, sLocalFile As String, _
cmd As String, RetVal As Integer
sURL = UserForm1.TextBoxImgURL
sLocalFile = "C:\temp\" & UserForm1.TextBoxName
DownloadFile sURL, sLocalFile ' Function to download image from a URL and save it to a local directory
RetVal = Shell("convert.exe """ & sLocalFile & """ """ & sLocalFile & ".jpg""")
UserForm1.Hide
End Sub
When I run this, the image gets downloaded just fine, but the image isn't converted and no error is thrown. Furthermore, when I execute the command that the Shell command executes in a separate command window, the conversion happens exactly as I would expect.
So the question then seems to be why is the ImageMagick command working beautifully when it is operating in its own command prompt, but not working at all when operating from within VBA?
[1] I don't know if this is useful information or not, but I'm downloading the images from the internet programmatically, so I have no means of knowing what format I'm getting; however, the image I've been using to test this with is a PNG.
The problem is the Shell is really only for opening programs. Therefore, it is necessary to actually tell it to open a command prompt and run the appropriate command. This can be done by changing the line with the Shell command to the following:
RetVal = Shell("cmd.exe /c convert.exe """ & sLocalFile & """ """ & sLocalFile & ".jpg""")
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.