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
Related
Hy, I have an excel workbook which consists of six worksheets. Everything is working fine in the workbook. I have written a macro which helps me to take the backup of current workbook instead of the current worksheet. The code is as under.
Sub FileSaveAs()
Dim strFolder As String
Dim i As Long
'Find the position of the period in the file name
i = InStr(ActiveWorkbook.Name, ".")
'Create a default file name by concatenating the file name without the extention _
plus the current date and time, and plus the xlsm extention
Filename = Left(ActiveWorkbook.Name, i - 1) & "_" & Format(Now, "yyyy-mm-dd_hh mm") & ".xlsm"
'Open Save As dialog to a default folder with default file name
With Application.FileDialog(msoFileDialogSaveAs)
.AllowMultiSelect = False
.FilterIndex = 2 '2 = xlsm
.InitialFileName = "Report" & Filename
.InitialView = msoFileDialogViewDetails
If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
.Execute
End With
End Sub
It is working fine for taking backup of workbook instead of the current working sheet without losing any data or formate or setting in the worksheet.
I have two problems.
1- When I click on the backup button, the active workbook is closed and backup workbook is opened.
2- I tried my best to take the backup of the current working sheet without losing any data or formating but I cloud not do so because everything when I click on the backup button for the current worksheet (I have written another macro to take backup for current worksheet but it is not working so I did not write it here) is lost.
What I want to do. I want to do two things.
1- When I click the backup button, the original worksheet remain open while the backup worksheet should remain close, so that I can take different name backups from same master worksheet.
2- If possible, I want a macro which helps me to take the backup of the active sheet without losing any data or information on the sheet.
Please guide where i am doing wrong. Thanks for every member.
Try,
Sub FileSaveAs()
Dim strFolder As String
Dim i As Long
Dim Fn As String
Dim Wb As Workbook
Set Wb = ThisWorkbook
Fn = Wb.FullName
Wb.Save
'Find the position of the period in the file name
i = InStr(ActiveWorkbook.Name, ".")
'Create a default file name by concatenating the file name without the extention _
plus the current date and time, and plus the xlsm extention
Filename = Left(ActiveWorkbook.Name, i - 1) & "_" & Format(Now, "yyyy-mm-dd_hh mm") & ".xlsm"
'Open Save As dialog to a default folder with default file name
With Application.FileDialog(msoFileDialogSaveAs)
.AllowMultiSelect = False
.FilterIndex = 2 '2 = xlsm
.InitialFileName = "Report" & Filename
.InitialView = msoFileDialogViewDetails
If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
.Execute
End With
Set Wb = ActiveWorkbook
Workbooks.Open (Fn)
Wb.Close (0)
End Sub
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 am trying to create a linked table in Access to my Excel spreadsheet that includes hyperlinks. After going through the wizard, my table does not have hyperlinks anywhere. The field type is automatically set to Short Text.
Does anyone know of a fix or a workaround?
I think your terminology is a little messed up, but I'm guessing you are referring to this concept, right.
Option Compare Database
Option Explicit
Private Sub Command0_Click()
'Macro Loops through the specified directory (strPath)
'and links ALL Excel files as linked tables in the Access
'Database.
Const strPath As String = "C:\your_path_here\" 'Directory Path
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
'Loop through the folder & build file list
strFile = Dir(strPath & "*.csv")
While strFile <> ""
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend
'see if any files were found
If intFile = 0 Then
MsgBox "No files found"
Exit Sub
End If
'cycle through the list of files & link to Access
For intFile = 1 To UBound(strFileList)
DoCmd.TransferText acLinkDelim, , _
strFileList(intFile), strPath & strFileList(intFile), True, ""
'Check out the TransferSpreadsheet options in the Access
'Visual Basic Help file for a full description & list of
'optional settings
Next
MsgBox UBound(strFileList) & " Files were Linked"
End Sub
It is probably better to practice with CSV files, which are easier to work with, compared to Excel files. To loop through Excel files in a folder, and link to each, just change one line of code.
DoCmd.TransferSpreadsheet acLink, , "Your table name","Path to your workbook file", True, "Sheet1!Ran
Hi i am looking dynamic path to be taken for uploading excel file and should ask where to save the file. here is my code.`where as i tried but it is taking only static path. Any help would be appreciated.
'To Combine Sheets
Dim WorkbookDestination As Workbook
Dim WorkbookSource As Workbook
Dim WorksheetSource As Worksheet
Dim FolderLocation As String
Dim strFilename As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
'This line will need to be modified depending on location of source folder
FolderLocation = "U:\ECA" 'file location need to be dynamic
'Set the current directory to the the folder path.
ChDrive FolderLocation
ChDir FolderLocation
'Dialog box to determine which files to use. Use ctrl+a to select all files in folder.
SelectedFiles = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)
'Create a new workbook
Set WorkbookDestination = Workbooks.Add(xlWBATWorksheet)
strFilename = Dir(FolderLocation & "\*.xls", vbNormal) 'file name should be specified by user input and output file
'Iterate for each file in folder
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Set WorkbookSource = Workbooks.Open(Filename:=FolderLocation & "\" & strFilename)
Set WorksheetSource = WorkbookSource.Worksheets(1)
WorksheetSource.Copy After:=WorkbookDestination.Worksheets(WorkbookDestination.Worksheets.Count)
WorkbookSource.Close False
strFilename = Dir()
Loop
WorkbookDestination.Worksheets(1).Delete
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=FolderLocation
Application.DisplayAlerts = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True`
This block of code is good once everything is running properly: Application.DisplayAlerts = False Application.EnableEvents = False Application.ScreenUpdating = FalseUntil your code is completely debugged, though, it will make your life a nightmare. Comment those 3 out until this procedure is running the way you want it.
you appear to declare (Dim) some of your variables, but not all. I would strongly recommend adding Option Explicit to the top of all your code modules to force variable declaration prior to use - it helps prevent typos in variable names from messing things up down the road.
You assign SelectedFiles the return value from Application.GetOpenFilename, but don't ever use it. When it's assigned, you will have an array of file names that the user selected, and they will include the full path. This may provide the path information you need (the dialog box will allow the user to navigate to the desired folder), but I'm not sure, because...
You assign strFilename = Dir(FolderLocation & "\*.xls", vbNormal) which gives you the first *.xls file located in FolderLocation. You then loop through all the *.xls files there.
I would suggest that using your existing code, you could pull the path information from SelectedFiles like this:
SelectedFiles = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=False)
If InStrRev(SelectedFiles, "\") > 0 Then
FolderLocation = Left(SelectedFiles, InStrRev(SelectedFiles, "\"))
End If
Note that I changed Multiselect:=False to allow the user to only select one file - I don't see where you're using this variable anywhere else, so I've modified it to simply use it as a path picker. If that's incorrect, you'll have to make another modification to select the path. Otherwise, FolderLocation will now point to the directory that the user selected and you can continue your looping after that using the folder they selected.
I want to use a wildcard to open a workbook stored in the same folder as my macro workbook. In the folder is a file named 302113-401yr-r01.xlsm. Here is my code:
Workbooks.Open filename:=ActiveWorkbook.Path & "\302113*.xlsm"
However, it tells me that there is no such file. Any advice?
We cannot open a file using a wildcard - imagine the chaos if we could!
You'll need to use Dir(ActiveWorkbook.Path & "\302113*.xlsm") to loop through the files that this returns. If there will only be one then just use this function once:
Dim sFound As String
sFound = Dir(ActiveWorkbook.Path & "\302113*.xlsm") 'the first one found
If sFound <> "" Then
Workbooks.Open filename:= ActiveWorkbook.Path & "\" & sFound
End If
Dir Function :tech on the net
From my experience this works if you have the wildcard/asterix as the last symbol in the string and if there is only one file. Try doing:
Workbooks.Open filename:=ActiveWorkbook.Path & "\302113*"
For example I am using:
Workbooks.Open Filename:="X:\business\2014\Easy*"
and it works.
You can open files using the wildcard, but only with UNC paths for some reason.
For example :
Set xlFile = xlObj.WorkBooks.Open("\\yourServerHere\dataAutomation\*.xlsx")
I'm not that experienced yet with Excel but the following works well for me for using wildcards in filenames to open files. This example requires all files to be in the same directory/folder. Yes, it is pretty simplistic.
Sub using_wildcards_to_open_files_in_excel_vba()
Dim mypath As String
Dim sFilename As String
'Suppose you have three files in a folder
' Named blank.xlsx,, ex1_939_account.xlsx, and ex1_opt 5.xlsx
'Manually open the blank.xlsx file
'The following code lines will open the second two files before closing the previously opened file.
ActiveWorkbook.Activate
mypath = ActiveWorkbook.Path
'opening xlsx file with name containing "939" and closing current file
mypath = mypath & "\*939*.xlsx"
'MsgBox mypath 'Checking
sFilename = Dir(mypath)
'MsgBox sFilename 'Checking
ActiveWorkbook.Close savechanges:=False
Workbooks.Open Filename:=sFilename
ActiveWorkbook.Activate
mypath = ActiveWorkbook.Path
'opening xlsx file with name ending in "opt 5" and closing current file
mypath = mypath & "\*opt 5.xlsx"
'MsgBox mypath 'Checking
sFilename = Dir(mypath)
'MsgBox sFilename 'Checking
ActiveWorkbook.Close savechanges:=False
Workbooks.Open Filename:=sFilename
End Sub