I am stuck in a situation where I would like to create an automatic date-wise folder on the FTP account. Also, it requires moving one to two files in an updated folder every day. i.e. If it is 28-Dec-22 then the automatic folder with the mentioned format below should be created and the file then should be moved to the updated date folder.
the format of the date will be like this
2023/01/01
This means on the FTP and on the root directory there will be a year folder then in the year folder there will be a month folder and in the month folder, there will be date-wise folders (month and date will folder will be two digits only.
At the start of next month, it requires creating an automatic month folder (within the year folder) and then the normal date folders will be created. that will be 2023/02/01 and so on.
I am using the code mentioned below to move the file from source to destination and it also creates the date-wise folder but in this code, it can only send the file to one selected destination and this cannot be moved into the updated date-wise folder.
Sub moveAllFilesInDateFolderIfNotExist()
Dim DateFold As String, fileName As String, objFSO As Object
Const sFolderPath As String = "E:\Uploading\Source"
Const dFolderPath As String = "E:\Uploading\Destination"
DateFold = dFolderPath & "\" & Format(Date, "ddmmyyyy") ' create the folder if it does not exist
If Dir(DateFold, vbDirectory) = "" Then MkDir DateFold
fileName = Dir(sFolderPath & "\*.*")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Do While fileName <> ""
If Not objFSO.FileExists(DateFold & "\" & fileName) Then
Name sFolderPath & "\" & fileName As DateFold & "\" & fileName
End If
fileName = Dir
Loop
End Sub
Can anyone please help me in this situation?
Related
I am working in a project of VBA, and I need to open some Workbooks, but the name is kind of dynamic, but only the last name. Sometimes the name comes like "OnHand 066 May" and sometimes with "OnHand 006 Jun"
Dim Dir As String
Dir = ActiveWorkbook.Path
Do not use Dir as a variable name. It is a reserved function name.
Use a wildcard with the Dir function to find a file that matches.
The Dir function will not return a full path, so you have to append it again if you want to actually open the file.
Let's assume there is only one file in that folder that matches, as you did not specify that in your question.
Dim sFile As String
sFile = Dir(ActiveWorkbook.Path & "\OnHand*.xls*")
If sFile <> "" Then
' if you get an error on the next line, someone else may have it open already
Debug.Print "About to open: " & ActiveWorkBook.Path & "\" & sFile
WorkBooks.Open ActiveWorkBook.Path & "\" & sFile
Else
MsgBox "Cannot find a file like that"
End If
I'm trying to better understand the Dir function. I have a Dir loop to take action on all .csv files in the directory, but when the loop comes across another file type, like .txt, it will error instead of moving on to the next .csv. item.
This is the relevant portion of my code.
strSourceExcelLocation = "\\rilinfs001\Interdepartmental\Billings & Deductions\Billing Coordinators\MCB Reports\East\Monthly Quality MCBs (CMQ & SECMQ)\2019\Individual_Reports\" & fldr & "\"
strWorkbook = Dir(strSourceExcelLocation & "*.csv*")
Do While Len(strWorkbook) > 0
'Open the workbook
Set wbktoExport = Workbooks.Open(Filename:=strSourceExcelLocation & strWorkbook)
'Export all sheets as single PDF
Call Export_Excel_as_PDF(wbktoExport)
'Get next workbook
strWorkbook = Dir
'Close Excel workbook without making changes
wbktoExport.Close False
Loop
So if there are only .csv files in the directory, then this works fine. When it comes across another file type, an error occurs.
The error is on line
strWorkbook = Dir
Run-time error 5: Invalid procedure call or argument
Am I missing something with the way I use the wildcards in the .csv at the beginning?
Thank you
Solved my issue.
The problem seems to have been because when I called another procedure, I had another Dir in that sub to create a new folder if one didn't already exist. So basically I had a Dir in a Dir, which apparently is bad.
I moved the folder creation part to the very beginning of my procedure, so it is executed before I begin the Dir for looping through all the CSV files.
Option Explicit
Sub Loop_Dir_for_Excel_Workbooks()
Dim strWorkbook As String, wbktoExport As Workbook, strSourceExcelLocation As String, fldr As String, strTargetPDFLocation As String, d As String
strTargetPDFLocation = "\\nhchefs001\Accounting\IMAGING\BILLINGS & DEDUCTIONS\EAST MCB FILES\"
'***** Creating a folder to save the PDFs in. Naming the folder with today's date *****
d = Format(Date, "mm-dd-yyyy")
strTargetPDFLocation = "\\nhchefs001\Accounting\IMAGING\BILLINGS & DEDUCTIONS\EAST MCB FILES\" & d & "\"
If Len(Dir(strTargetPDFLocation, vbDirectory)) = 0 Then MkDir strTargetPDFLocation
fldr = InputBox("Input the EXACT Folder Name that you want to create PDFs for")
strSourceExcelLocation = "\\rilinfs001\Interdepartmental\Billings & Deductions\Billing Coordinators\MCB Reports\East\Monthly Quality MCBs (CMQ & SECMQ)\2019\Individual_Reports\" & fldr & "\"
'Search all Excel files in the directory with .xls, .xlsx, xlsm extensions
strWorkbook = Dir(strSourceExcelLocation & "*.csv")
Do While Len(strWorkbook) > 0
'Open the workbook
Set wbktoExport = Workbooks.Open(Filename:=strSourceExcelLocation & strWorkbook)
'Export all sheets as single PDF
Call Export_Excel_as_PDF(wbktoExport, strTargetPDFLocation)
'Close Excel workbook without making changes
wbktoExport.Close False
'Get next workbook
strWorkbook = Dir
Loop
End Sub
Try to hardcode the path and give it a try again. Probably the error is something really small in the hardcoding. E.g., in the code below, replace C:\Users\username\Desktop\AAA\ with the path of the file. Then run it. Do not forget the last \. It should work:
Sub TestMe()
Dim workbookPath As String
workbookPath = Dir("C:\Users\username\Desktop\AAA\" & "*.csv")
Do While Len(workbookPath) > 0
Debug.Print workbookPath
workbookPath = Dir
Loop
End Sub
I'm able to run this code without any error, however is giving a slightly different objective.
It'll be added below the Do Events section according to the code in the link below.
Loop through all excel file in given folder
Objective of code:
Browse folder for workbook in folder with date referencing to a range "H2" of current workbook and saving them in the same folder as file browsed
Current Situation:
Able to save file with date however it get saved in its earlier folder
E.g File exist in
C:\Users\Tyler\Desktop\Test
New file with date will be saved in
C:\Users\Tyler\Desktop
Codes
Dim CellDate As String, fName As String
fName = Left(ActiveWorkbook.Name, (InStrRev(ActiveWorkbook.Name, ".", -1, vbTextCompare) - 1))
CellDate = ThisWorkbook.Worksheets("Sheet1").Range("H2")
CellDate = Format(Date, "YYYYMMDD")
ActiveWorkbook.SaveAs fName & "-" & CellDate, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Appreciate the help (:
Have you tried
ActiveWorkbook.SaveAs myPath & fName & "-" & CellDate, FileFormat:=xlOpenXMLWorkbookMacroEnabled
If your code for folder selection is as per the link then its value will be stored in myPath.
Assuming "C:\Users\Tyler\Desktop\Test" was the folder selected.
Note:
Associated code from link....
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
I have been trying to use a code that ensures that there is a match from the input and output folders before moving input files into another folder. Here is a snippet:
'Select first Excel file within that Outlook_ImportedClaimsFiles folder path
OutlookImportFN = Dir(OutlookImportPath & "\*.xls")
'Select first Excel file within the SAS_Outputs folder path
SASOutputFN = Dir(SASOutputsPath & "\*.xls")
'Cycle through all files in the source folder path until there are no more left to cycle through
Do While OutlookImportFN <> ""
Counter = Counter + 1
'Create full path name of the source file
sFilePathName = OutlookImportPath & "\" & OutlookImportFN
'Create full path name of the destination file and add the date and time the file was moved
dFilePathName = OutlookRunPath & "\" & Format(Now, "yyyymmdd") & "_" & OutlookImportFN
The problem is that in the first folder (OutlookImportFN), there is a batch/holding file that contains the filenames for all the files in that folder that is used in the overall process. When flagging the first file, this file comes up first (this file shouldn't be flagged/selected at all). Because of this, when doing the comparison, the files don't match (unless I start with the 2nd file in the list). How do I either start with the 2nd file in the Input folder when comparing to the 1st file in the Output folder, or skip over this holding file in the Input folder when doing the comparison? I've tried a few things but nothing seems to work. Thanks in advance for your insight!
You need to add an If statement which makes sure the file isn't that batch file:
Do While OutlookImportFN <> ""
Counter = Counter + 1
If Not OutlookImportFN = "MyBatchFile" Then
'Create full path name of the source file
sFilePathName = OutlookImportPath & "\" & OutlookImportFN
'Create full path name of the destination file and add the date and time the file was moved
dFilePathName = OutlookRunPath & "\" & Format(Now, "yyyymmdd") & "_" & OutlookImportFN
End If
I have created a VBA macro that pulls files from folder/subfolders based on a number of parameters. This includes finding zip folders that meet those parameters and copying them to a new directory so that each file can be searched through also. The problem that I'm having is that many of the files in those zips are duplicates, and as the project is to be automated, I cannot sit there and push the don't copy button every time it pops up. Is there a way to search through zip files and ignore the duplicate files? What I have for this part of my code is:
Sub Unzip(fileName As String, mainSubfolder As String)
Dim sourceDir As String, fileString As String
Dim FileNameFolder As Variant
Dim oApp As Object
sourceDir = "\\Filesrv02\depts\AR\EDIfiles\Remits"
fileString = mainSubfolder + fileName
If Right(sourceDir, 1) <> "\" Then
sourceDir = sourceDir & "\"
End If
FileNameFolder = sourceDir & "Unzipped"
If Dir(FileNameFolder, vbDirectory) = vbNullString Then
MkDir FileNameFolder
End If
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fileString).Items
End Sub
The last two lines are where I copy files from the zip folder into a new folder called "Unzipped". However, I'm not sure how to get at each individual file in the zip folder to say if it already exists, ignore it. Any suggestions would be greatly appreciated!
Maybe this helps:
(taken from: https://stackoverflow.com/a/14987890/3883521)
With oApp.NameSpace(ZipFile & "\")
If OverwriteFile Then
For Each fil In .Items
If FSO.FileExists(DefPath & fil.Name) Then
Kill DefPath & fil.Name
End If
Next
End If
oApp.NameSpace(CVar(DefPath)).CopyHere .Items
End With