So far all the examples for checking if a file is in a directory has been to get a list of files in that directory then compare your items to it. This is a lot of overload for me. I have a list of about 125 files and the directory I want to search in has 8000 files. Can someone instruct me on how to use a file with a list of file names and search a directory for each file.
Moved here from comments:
The code below works, but because it's searching through 8000 files in
a directory the code takes a long time to work. I have a document with
350 lines of file names. Instead of going through each file in the
directory for a match to one of the file names in my document. I'd
like to take my list and search the directory for that file. This way
I'm only looping 350 times instead of 8000
Here is my code.
Dim fileNames As String() = System.IO.Directory.GetFiles(imgLocation)
Dim i As Integer
statusText = "Copying Image Files"
i = 0
' Loop over the filenames retrieved
For Each fileName As String In fileNames
' Check if the files is contained or not in the request list
If GraphicList.Contains(Path.GetFileNameWithoutExtension(fileName)) Then
'Debug.Write("Filename " & fileName & vbCr)
Dim FileNameOnly = Path.GetFileName(fileName)
Dim copyTo As String
copyTo = createImgFldr & "\" & FileNameOnly
System.IO.File.Copy(fileName, copyTo, True)
' Do not write to file inside the loop, just add the fact to the list
' Debug.Write("Copy image " & FileNameOnly & vbCr)
imgFilename = (FileNameOnly) + vbCrLf
ImageCount1 = i
BackgroundWorker1.ReportProgress(100 * i / GraphicList.Count())
foundImgFiles.Add(FileNameOnly)
Else
Debug.Write("Missing " & FileNameOnly & vbCr)
notfoundImgFiles.Add(fileName)
End If
i = i + 1
Next
Related
I would like to simulate a folder copy exactly how it would happen if a user copy/pasted it in Windows Explorer (keep all the file/directory attributes, copy all subfolders and files in the same structure, etc.), and be able to update a progress bar during the copy.
FileSystem.Copy is a wonderful function that would mimic a user copy/paste, but I am unable to update a progress bar during the copy using that function.
The only way I have found to be able to achieve this is to write a custom function, so the ProgressBar.Maximum can be set to the size of the Folder and the ProgressBar.Value is updated after each individual file copy.
This function is becoming a lot of code to achieve something that seems simple. I also cannot disregard the notion that since this is customized that I am doing something wrong that I just don't know to test for. For example, had the folder I was testing with not had empty subfolders and hidden folders, I never would have adjusted for those things.
So I have to wonder if I am overlooking something much simpler to achieve this same goal.
My code is as follows:
Private Sub CopyFolderWithProgress(folderToCopy As String, newFolder As String, progBar As ProgressBar)
'Validate folder to copy
If Directory.Exists(folderToCopy) Then
If folderToCopy.Substring(folderToCopy.Length - 1) <> "\" Then
folderToCopy &= "\"
End If
Else
MsgBox("Invalid directory given: " & folderToCopy)
End
End If
'Validate new folder
If Directory.Exists(newFolder) Then
If newFolder.Substring(newFolder.Length - 1) <> "\" Then
newFolder &= "\"
End If
Else
MsgBox("Invalid directory given: " & newFolder)
End
End If
'Create folderToCopy as a new subfolder of newFolder
newFolder &= New DirectoryInfo(folderToCopy).Name & "\"
Dim di As DirectoryInfo
di = Directory.CreateDirectory(newFolder)
di.Attributes = New DirectoryInfo(folderToCopy).Attributes
'Create all subfolders
For Each thisDir In Directory.GetDirectories(folderToCopy, "*", SearchOption.AllDirectories)
Dim thisDirRelative = thisDir.Remove(0, Len(folderToCopy))
di = Directory.CreateDirectory(newFolder & thisDirRelative)
di.Attributes = New DirectoryInfo(thisDir).Attributes
Next
'Determine size of all files for progress bar
Dim dirSize As Long
For Each curFile In Directory.GetFiles(folderToCopy, "*", SearchOption.AllDirectories)
dirSize += FileLen(curFile)
Next
'Set progress bar 100% to size of all files
progBar.Value = 0
progBar.Maximum = dirSize
'Copy all files into correct folder and update progress bar
For Each curFile In Directory.GetFiles(folderToCopy, "*", SearchOption.AllDirectories)
'Get name of file
Dim curFileName = Path.GetFileName(curFile)
'Determine if file is in a subfolder of fileTopCopy
Dim curFileDir = Path.GetDirectoryName(curFile) + "\"
Dim curFileSubfolders = curFile.Substring(0, curFile.IndexOf(curFileName)).Replace(folderToCopy, "")
'Copy file
If File.Exists(curFile) Then
File.Copy(curFile, newFolder & curFileSubfolders & curFileName)
Else
Console.Write("Issue copying a file that should exist in source folder: " & curFile)
End If
'Update Progress Bar
progBar.Value += FileLen(curFile)
Next
End Sub
Dim d As String
d = "K:\example\" & SaveComboBox1.Text & "\" & SaveComboBox2.Text & "\" & "ward.txt"
If objFSO.fileexists(d) Then
objFile = objFSO.GetFile(d)
objFile.delete(True)
objFSO.CopyFile(d, "K:\example\ward.txt")
End If
objFSO.CopyFile(d, "K:\example\ward.txt")
.inputs would come from 2 combobox selections..It asks to make sure that the file existed, but the file really do exist
I have created a macro that I can use to print PDF files. The PDF files will be saved in a folder to print. The path will be given that folder path where I save all PDF files. My questions are:
1) Once the files are saved in folder, is it possible to sort it automatically like first come first print. Now the issue is - prints did not come out in order of how the files are – we have to reconcile all files, so looking for each one in a random list order would take lots of time.
2) Is it possible to have the files automatically deleted from the folder after the printing is completed?
Public Sub Print_All_PDF_Files_in_Folder()
Dim folder As String
Dim PDFfilename As String
folder = "\\maple.fg.rbc.com\data\toronto\user_3\315606053\myWorkspace\Desktop\test" 'CHANGE AS REQUIRED
If Right(folder, 1) <> "\" Then folder = folder & "\"
PDFfilename = Dir(folder & "*.pdf", vbNormal)
While Len(PDFfilename) <> 0
If Not PDFfilename Like "*ecg*" Then
Print_PDF folder & PDFfilename
End If
PDFfilename = Dir() ' Get next matching file
Wend
End Sub
Sub Print_PDF(sPDFfile As String)
Shell "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe /p /h " & Chr(34) & sPDFfile & Chr(34), vbNormalFocus
' This is path of Adobe in the desktop
End Sub
There is no build in way to sort files. However, it is rather easy to read the filenames and -dates into arrays and sort them manually, but you have to use the FilesystemObject rather than using dir to get the file dates.
You can find an example to do so for example here: https://social.msdn.microsoft.com/Forums/office/en-US/5f27936e-1d98-44df-8f69-0f81624c4b92/read-files-in-a-folder-in-descending-order-with-file-name-or-date-created?forum=accessdev
The command to delete a file with VBA is kill, or you can use the .DeleteFile method of FilesystemObject. However, this will work only if the printing is already done, so you have to wait for your shell-command to finish. For this, you have to use the wscript.shell, see for example here https://stackoverflow.com/a/8906912/7599798
So I am writing a script for a client (I don't use VB) and it needs to pull all files from specified folders which I'm using an INI file to accomplish. It then combines every PDF in the folder, sends an email to a fax machine and sends the combined PDF to a new folder.
The issue I'm having is I can't seem to figure out how to make sure the first file selected in the PDF is the one I want. I made a dummy PDF and named it "_.pdf" hoping that since it would alphabetically land first that it would be combined first. But that isn't how VB is doing things when it pulls the directory. There doesn't seem to be any constant sorting to my knowledge. So I created a function to sort all files in a folder into an array which works. Now my problem is combining the PDF. The code I was using was simply combining an entire directory in command line. So I'm a bit lost.
Function CombinePDF(folder, combinedFile)
'On Error Resume Next
Dim cmdToRun
set Shell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set outputPDF = CreateObject("System.Collections.ArrayList")
For Each f in fso.GetFolder("c:\TestScript\" + folder).Files
outputPDF.Add f.Name
Next
outputPDF.Sort()
For Each pdf in outputPDF
'The below line is the issue. I had a working one here with *.pdf off
'of the folder. But this is the current code
cmdToRun = "pdftk c:\TestScript\" + folder + "\" + pdf + _
"output c:\TestScript\" + combinedFile + ".pdf"
Shell.Run(cmdToRun)
Next
WScript.Sleep 1000
Set objFolder = CreateObject("Scripting.FileSystemObject")
For Each oFile in objFolder.GetFolder("C:\TestScript\" + folder).Files
If oFile.Name <> "_.pdf" Then
'oFile.Move "C:\TestScript\" + folder + "-Processed\"
End If
Next
End Function
As shown in the documentation HERE, if you have to merge 2 input files say in1.pdf and in2.pdf into a new PDF say out1.pdf, you have to write the command:
pdftk in1.pdf in2.pdf cat output out1.pdf
So, you need to construct a string which contains the paths to all the input files separated by a space.
If you have the sorted file names in the array list, then you can try replacing:
For Each pdf in outputPDF
cmdToRun = "pdftk c:\TestScript\" + folder + "\" + pdf + "output c:\TestScript\" + combinedFile + ".pdf"
Shell.run(cmdToRun)
Next
with
inputFiles=""
For Each pdf in outputPDF
inputFiles = inputFiles & "c:\TestScript\" & folder & "\" & pdf& " "
Next
cmdToRun = "pdftk " & inputFiles & "output c:\TestScript\" + combinedFile + ".pdf"
Shell.run(cmdToRun)
I couldn't find an existing thread fitting my problem and now I'm stuck and searching for help ;)
What I want to accomplish: Several .xlsx tables filled with content are in the same folder, I want to pick the same two cells' content out of every file and save it to a newly created .xslx file named "Summary.xlsx".
My makro reads out the cells' content properly and also saves the Summary.xlsx. However it looks like the file is corrupted because when I try to open it Excel would show me just a blank page (not even a sheet).
Watching the file using breakpoints, the headlines get written properly: However the table in Summary.xlsx starts to disappear right when I try to write the content of the other files in the do-while-loop.
Additional info: I start the makro from an extra makro-file in the same directory as the other files using the play button in the module.
Here's my code.
Warning: I'm new to VBA, obviously :)
Sub MergeMakro()
Dim directory As String, fileName As String, otherWorkbook As Workbook, sumFileName As String, sumFilePath As String, i As Integer
thisFileName = "MergeMakro.xlsm"
sumFileName = "Summary.xlsx"
sumFilePath = ThisWorkbook.Path & "\" & sumFileName
' If sum file already exists, delete it
If Dir(sumFilePath) <> "" Then
Kill (sumFilePath)
End If
' create new sum file
Set sumWorkbook = Workbooks.Add
ActiveWorkbook.SaveAs fileName:=sumFilePath
Set sumSheet = sumWorkbook.ActiveSheet
' search in the file's directory
directory = "R:\ExcelStuff\Auswertungen\"
' headlines -> are written properly
sumSheet.Range("A1") = "Materialnummern"
sumSheet.Range("B1") = "Bezeichnung"
sumSheet.Range("C1") = "Gesamtkosten"
' start at line 2
i = 2
fileName = Dir(directory & "*.xls")
Do While fileName <> ""
If fileName <> thisFileName And fileName <> sumFileName Then
Set otherWorkbook = Workbooks.Open(directory & fileName)
' do not show windows
If Not (ActiveWorkbook Is Nothing) Then
ActiveWindow.Visible = False
End If
' remove last 5 chars of string (.xlsx)
fileName = Left(fileName, Len(fileName) - 5)
' do not try to open the makro-file itself
Set otherSheet = otherWorkbook.Sheets(fileName)
' write data into file -> here the file starts to get corrupted
sumSheet.Range("A" & i) = fileName
sumSheet.Range("B" & i) = otherSheet.Range("C4")
sumSheet.Range("C" & i) = otherSheet.Range("G4")
i = i + 1
otherWorkbook.Close
End If
' get the next file
fileName = Dir()
Loop
Workbooks(sumFileName).Save
Workbooks(sumFileName).Close
End Sub
Thanks in advance!