This question already has an answer here:
Excel VBA - MkDir returns "Path not Found" when using variable
(1 answer)
Closed 8 years ago.
I have a VBA subroutine to loop through the rows of an excel spreadsheet and copy a file from the path stored in one cell to a path made up of information from several other cells. Much of the time a folder will need to be created for the file but it's only one level deeper (not trying to However, when I run it I sometimes will get a runtime error 76 path not found. When I look at the folder in Windows Explorer the folder appears, but is slightly transparent (like a file that is being written to).
Why am I running into this error at fso.Createfolder strDirPath? I'm guessing this has to do with timing because when I run the script again it can pass over the file just fine. Is there some way to check that the folder is ready?
Sub CopyFiles()
' Copy to location [root_folder]\company_name\contract_no'_'file_name
Dim strRootFolder, strCompany, strContract, strFileName, strDirPath
Dim strFullPath, strFromPath, intRow
strRootFolder = "C:\...\DestinationFolder\"
intRow = 2
Dim fso As New FileSystemObject
'Loop through rows
Range("C" & 2).Select 'First row to check (column always filled)
Do Until IsEmpty(ActiveCell) ' Loop through till end of spreadsheet
strFromPath = objSheet.Range("C" & intRow).Value
' Replace "/" characters in company names with "_"
strCompany = Replace(objSheet.Range("E" & intRow).Value, "/", "_")
strContract = objSheet.Range("A" & intRow).Value & "_"
' Replace "#" in file names with "0"
strFileName = Replace(objSheet.Range("B" & intRow).Value, "#", "0")
strDirPath = strRootFolder & strCompany & "\"
strFullPath = strDirPath & strContract & strFileName
' Create directory if it does not exist
If Not fso.FolderExists(strDirPath) Then
fso.Createfolder strDirPath ' !!! This is where the error is !!!
End If
' Copy file
fso.CopyFile strFromPath, strFullPath, False
intRow = intRow + 1
ActiveCell.Offset(1, 0).Select ' drop one to check if filled
Loop
End Sub
Note: This is not because of a backslash in the directory name. The code replaces backslashes and there are no forward slashes in the input.
The issue is that the directory that is being created ends in a space. In Windows explorer, if you create a folder with a space at the end it automatically trims the name. However, in VBA it isn't automatically done.
The fix is to call Trim() around your directory name:
strDirPath = Trim(strRootFolder & strCompany) & "\"
Tip:
The folders with trailing spaces were created but will cause issues in Windows. To rename or remove them you will need to use the command line with a network path syntax. (See Rename/Delete Windows (x64) folder with leading and trailing space)
rename "\\?\c:\<PATH HERE>\ 1 " "<NEW FILE NAME>"
Related
I am currently working on user customisability in VBA while searching through some other workbooks. I am having issues converting my FileName expression in the Dir() function into a path directory with the correct backslash after my folder name, and then using wildcards around File to allow Dir to search for all occurrences of a keyword. Currently I believe the \ is omitted, and I can't yet tell if my wildcards are working
' Modify this folder path to point to the files you want to use.
Folder = InputBox("Enter folder directory of files")
' e.g C:\peter\management\Test Folder
File = InputBox("Enter filename keyword")
'e.g. PLACE
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(Folder & "\" & "*" & File & "*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
I am assuming my syntax is incorrect for what I am trying to achieve. Any help would be appreciated!
EDIT:
' Modify this folder path to point to the files you want to use.
Folder = InputBox("Enter folder directory of files")
' e.g C:\peter\management\Test Folder
File = InputBox("Enter filename keyword")
'e.g. PLACE
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(Folder & "\" & File & "*" & ".xls")
Debug.Print (FileName)
' Loop until Dir returns an empty string.
Do While FileName <> ""
Is what I am currently working with. The "\" in my Dir line doesn't seem to do anything as I still have to add the final \ before the file manually for it to appear in my error message.
When I tried your code it worked for me. Needless to say, that makes it a little tricky to provide a satisfactory answer!
Below is my attempt to solve the same problem.
Instead of asking the user to manually type the folder address I've used Excel's built-in folder picker. This avoids the need to check for and deal with typos.
Sub FindFiles()
Dim fldDialog As FileDialog ' Holds a reference to the folder picker.
Dim path As String ' Folder selected by user.
Dim fileFilter As String ' Provided by user, wildcard supported.
Dim found As String ' Used to display returned results.
' Config dialog.
Set fldDialog = Application.FileDialog(msoFileDialogFolderPicker)
fldDialog.Title = "Pick a folder" ' Caption for dialog.
fldDialog.AllowMultiSelect = False ' Limit to one folder.
fldDialog.InitialFileName = "C:\" ' Default starting folder.
' Display to user.
If fldDialog.Show Then
' Config filter.
path = fldDialog.SelectedItems(1)
fileFilter = InputBox("Select a filter (*.*)", "File filter", "*.*")
' Get results.
found = Dir(path & "\" & fileFilter)
Do Until found = vbNullString
MsgBox found, vbInformation, "File found"
found = Dir()
Loop
Else
MsgBox "User pressed cancel", vbInformation, "Folder picker"
End If
End Sub
I am trying to write a VBA Script which converts the excel file to XML. I am fetching the file name using Application.GetSaveAsFilename() function. But this function opens up the "Save As" dialog box. I want to suppress the dialog such that the user is not prompted to manually click save each time the code is run. Instead, the XML should be silently generated at the location hard-coded.
Code:
Sub BasicRTE()
Dim FileName As Variant
Dim Sep As String
Dim Ws As Worksheet
Dim autoSetFileName As String
Dim folderName As String
Dim location As Integer
ChDrive (Left(ThisWorkbook.Path, 1))
ChDir ThisWorkbook.Path
ChDir ".."
ChDir "InputFiles"
Application.SendKeys ("{ENTER}")
FileName = Application.GetSaveAsFilename( _
InitialFileName:=ThisWorkbook.Worksheets(1).Name, _
FileFilter:="Xml Files (*.xml),*.xml")
location = InStrRev(FileName, "\", , vbTextCompare)
folderName = Mid(FileName, 1, location - 1)
For Each Ws In ThisWorkbook.Worksheets
If InStr(1, Ws.Name, "#", vbTextCompare) <> 1 Then
ExportToMyXMLFile FName:=CStr(folderName & "\" & Ws.Name & ".xml"), Sep:=CStr(Sep), _
AppendData:=False, Ws:=Ws
End If
Next
End Sub
It appears that the only thing you are using Application.GetSaveAsFilename for is to get the path to the InputFiles path with respect to the location of ThisWorkbook into folderName. The operating system already provides that! The following changes should work (but I have not tested them myself):
' fileName = ... ' don't need this
' location = ... ' or this
folderName = ThisWorkbook.Path & "\..\InputFiles" ' e.g., C:\Users\Foo\Documents\..\InputFiles
Alternatively, if you want a cleaner string,
Dim location as Long ' Never use Integer unless you are calling Win32 or something else esoteric
' Don't need any of this unless later code relies on the current directory
' (which it shouldn't, for robustness).
'ChDrive (Left(ThisWorkbook.Path, 1))
'ChDir ThisWorkbook.Path
'ChDir ".."
'ChDir "InputFiles"
'Application.SendKeys ("{ENTER}")
'FileName = Application.GetSaveAsFilename( _
' InitialFileName:=ThisWorkbook.Worksheets(1).Name, _
' FileFilter:="Xml Files (*.xml),*.xml")
folderName = ThisWorkbook.Path
location = InStrRev(folderName, "\", , vbTextCompare)
folderName = Mid(folderName, 1, location) & "InputFiles"
For Each ws ...
The InStrRev+Mid drops the last path component, just like .., and then the & "InputFiles" puts InputFiles on the end.
One caution: ThisWorkbook.Path is an empty string for a new, unsaved workbook. Make sure your workbook is saved to disk before using the above.
Edit another caution: you are using ws.Name directly in making filenames. However, sheet names can include text that filenames cannot. I can name a sheet CON or <foo>, but neither of those is valid in a filename. Here's one example of sanitizing filenames (a quick Google result — not tested). However, even that example does not appear to check for reserved names.
Reserved names: CON, PRN, AUX, NUL, COM1, COM2, COM3, COM4, COM5, COM6, COM7, COM8, COM9, LPT1, LPT2, LPT3, LPT4, LPT5, LPT6, LPT7, LPT8, and LPT9 per MS).
I have a Macro that gets sub folder data. However I also want something from the main folder.
I looked at How to get current working directory using vba? but need to change activeworkbook path:
Application.ActiveWorkbook.Path might be "c:\parent\subfolder"
I would want
"c:\parent\"
Using Excel 365 VBA
As the path may not be the current working directory you need to extract the path from the string.
Find the last \ and read all characters to the left:
ParentPath = Left$(Path, InStrRev(Path, "\"))
If you are working around the current directory ChDir ".." will jump you up one level, the new path can be returned by CurrDir.
The most reliable way to do this is to use the Scripting.FileSystemObject. It has a method that will get the parent folder without trying to parse it:
With CreateObject("Scripting.FileSystemObject")
Debug.Print .GetParentFolderName(Application.ActiveWorkbook.Path)
End With
Dim WbDir As String
Dim OneLvlUpDir As String
'get current WorkBook directory
WbDir = Application.ActiveWorkbook.Path
'get directory one level up
ChDir WbDir
ChDir ".."
'print new working directory and save as string. Use as needed.
Debug.Print CurDir()
OneLvlUpDir = CurDir()
I think you mean this solution:
Sub t()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
MsgBox "ThisWorkbook.Path = " & ThisWorkbook.Path & vbLf & _
"Path one folder down = " & fso.GetFolder(ThisWorkbook.Path & "\." & "NewFolder").Path
Set fso = Nothing
End Sub
I want to open and copy sheet in file TFM_20150224_084502 and this file has different date and time each day. I have developed code until open the date format but I can't develop to open it with time format.
What's the more code for it?
Sub OpenCopy ()
Dim directory As String, fileName As String, sheet As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "z:\FY1415\FI\Weekly Report\Astry"
fileName = "TFM_" & Format(Date, "yyyymmdd") & ".xls"
Workbooks.Open "z:\FY1415\FI\Weekly Report\Astry\" & "TFM_" & Format(Date, "yyyymmdd") & ".xls"
Sheets("MSP").Copy After:=Workbooks("Generate Report 2.xlsm").Sheets("PlanOEE")
ActiveSheet.Name = "MSP"
End sub
It seems that some linebreaks have disappeared when you posted the code into your post, but assuming you are aware of this, I assume that the main problem you have is figuring out the name of the file you want to open?
The VBA Dir-function lets you search for a file in a folder, and lets you include wildcards in your search. I've included this function in your sub, and have tested it with a similarly named file on my computer (albeit without the copying of the sheet), and it opened the sheet:
Sub OpenCopy()
Dim directory As String, fileName As String, sheet As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "z:\FY1415\FI\Weekly Report\Astry\"
fileName = Dir(directory & "TFM_" & Format(Date, "yyyymmdd") & "*.xls*")
If fileName <> "" Then
With Workbooks.Open(directory & fileName)
.Sheets("MSP").Copy After:=Workbooks("Generate Report 2.xlsm").Sheets("PlanOEE")
End With
ActiveSheet.Name = "MSP"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
The line relevant for finding the filename is, as you probably see:
fileName = Dir(directory & "TFM_" & Format(Date, "yyyymmdd") & "*.xls*")
I have simply used Dir to do a search for file fitting the string inside the parantheses, where the asterisks are wildcards. The reason I have included an asterisk after xls too is because there is a chance the file can have extensions such as xlsx or xlsm in newer versions of office. I've also added a backslash at the end of the directory string, since you'll have to include it before the filename anyway.
I have also added an if-clause around what you do with the workbook you open, in case no file fitting the search is found.
Note that this sub will only do what you want provided that there only is one file generated for each date. If you want to loop through all files which includes a given date, I would recommend having a look at this post here on SO, which explains how to loop through all files in a folder, modifying the macros presented there to fit your needs should be fairly trivial.
I have a large macro program run through Excel 2010 that, after formatting large amounts of data into another table and exporting the workbook as a CSV file (by large amounts of data I mean thousands of rows, up to over 59,000 rows). Recently, my files have started ending up with an extra row of commas at the end like so:
data,data,data,data,number,date
data,data,data,data,number,date
,,,,,
I am exporting these files to an SQL database using a stored procedure, so ensuring that there are no extra commas to screw with the program is essential. So, with that said, what is happening and how can I prevent it? I can provide any code or information that you believe is missing.
NOTE: It only appears to be happening on files with a couple thousand lines at least of data. One file exported often has 2,000+ and another must have 59,000+ for the table to be exported.
EDIT1: Here's the macro I'm using, just in case it would be helpful (requested by Ditto)
Sub exportTable()
Dim varIsOpen As Boolean
Dim varSaveLocation1 As String, varSaveLocation2 As String
varIsOpen = False
If ThisWorkbook.Sheets("ControlSheet").Range("D2").value = "" Then
varSaveLocation1 = ThisWorkbook.Path & "\CSVREVIEW\"
varSaveLocation2 = varSaveLocation1 & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now)
Else
varSaveLocation1 = ThisWorkbook.Sheets("ControlSheet").Range("D2").value
If Right(varSaveLocation1, 1) <> "\" Then varSaveLocation1 = varSaveLocation1 & "\"
varSaveLocation2 = varSaveLocation1 & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now)
End If
For counter = 1 To Workbooks.Count
If Workbooks(counter).Name = "TableBook.xls" Then varIsOpen = True
If varIsOpen = True Then Exit For
Next
If varIsOpen = False Then GoTo isClosed
Workbooks("TableBook").Activate
Application.DisplayAlerts = False
'Check if TableBook is empty and don't export if so
If Workbooks("TableBook").Sheets("logFile").Range("A1").value = "" Then
Workbooks("TableBook").Close
GoTo isClosed
End If
'On Error Resume Next
If Len(Dir(varSaveLocation1, vbDirectory)) = 0 Then
MkDir varSaveLocation1
End If
If Len(Dir(varSaveLocation2, vbDirectory)) = 0 Then
MkDir varSaveLocation2
End If
'On Error GoTo 0
ActiveWorkbook.Sheets("test").Activate
ActiveWorkbook.SaveAs varSaveLocation2 + "\test", xlCSV
ActiveWorkbook.Sheets("part").Activate
ActiveWorkbook.SaveAs varSaveLocation2 + "\part", xlCSV
ActiveWorkbook.Sheets("logFile").Activate
ActiveWorkbook.SaveAs varSaveLocation2 + "\logFile", xlCSV
ActiveWorkbook.Sheets("deltaLimits").Activate
ActiveWorkbook.SaveAs varSaveLocation2 + "\deltaLimits", xlCSV
ActiveWorkbook.Close
Application.DisplayAlerts = True
isClosed:
End Sub
Tap Ctrl+End to see what Excel believes are the extents of your data. If it is beyond what you want to export, use Home ► Editing ► Clear ► Clear All to wipe all values and formatting from the rows below and the columns to the right of your desired data region and save the workbook. Excel 2010 (with all SPs) will adjust to the CurrentRegion and Ctrl+End should now take you to the correct last cell.
Earlier versions of Excel (or XL2010 without all SPs) may require additional steps (see Unwanted extra blank pages in Excel).
I had an issue which looked the same (extra commas in csv) and it turned out that I was exporting one extra line in my loop and the cells I was using were empty, therefore I got commas only
I had the exactly same problem. If the entire sheet is formatted, even just Text type or Text Height, Excel detects even empty cells as data. You can delete the entire formatted columns/ rows as described above Cœur. Or just create a new sheet without formatting anything and copy your code or change the address.