Excel VBA using Workbook.Open with results of Dir(Directory) - vba

This seems so simple and I've had it working multiple times, but something keeps breaking between my Dir call (to iterate through a directory) and opening the current file. Here's the pertinent code:
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
'Start looping through directory
While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceCurrentFile)
What I get with this is a file access error as the Application.Workbooks.Open is trying to open "C:\ExcelWIP\TestSource\\FILENAME" (note extra slash)
However when I take the final slash out of SourceLoc, the results of Dir(SourceLoc) are "" (it doesn't search the directory).
The frustrating thing is that as I've edited the sub in other ways, the functionality of this code has come and gone. I've had it work as-is, and I've had taking the '/' out of the directory path make it work, and at the moment, I just can't get these to work right together.
I've scoured online help and ms articles but nothing seems to point to a reason why this would keep going up and down (without being edited except for when it stops working) and why the format of the directory path will sometimes work with the final '/' and sometimes without.
any ideas?

This would open all .xlxs files in that directory son.
Sub OpenFiles()
Dim SourceCurrentFile As String
Dim FileExtension as String: FileExtension = "*.xlxs"
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
SourceCurrentFile = Dir()
'Start looping through directory
Do While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceLoc &"\"& SourceCurrentFile)
SourceCurrentFile = Dir(FileExtension)
Loop
End Sub

JLILI Aman hit on the answer which was to take the results of Dir() as a string. Using that combined with the path on Application.Open allows for stable behaviors from the code.
New Code:
Dim SourceLoc as String
Dim SourceCurrentFile as String
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
'Start looping through directory
While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceLoc & "/" & SourceCurrentFile)
I didn't include the recommended file extension because I'm dealing with xls, xlsx, and xlsm files all in one directory. This code opens all of them.
Warning - this code will set current file to each file in the directory including non-excel files. In my case, I'm only dealing with excel files so that's not a problem.
As to why this happens, it does not appear that Application.Open will accept the full object results of Dir(), so the return of Dir() needs to be a String. I didn't dig deeper into the why of it beyond that.

Consider using VBA's FileSystemObject which includes the folder and file property:
Sub xlFilesOpen()
Dim strPath As String
Dim objFSO As Object, objFolder As Object, xlFile As Object
strPath = "C:\ExcelWIP\TestSource"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)
For Each xlFile In objFolder.Files
If Right(xlFile, 4) = "xlsx" Or Right(xlFile, 3) = "xls" Then
Application.Workbooks.Open (xlFile)
End If
Next xlFile
Set objFSO = Nothing
Set objFolder = Nothing
End Sub

Related

VBA can't kill the files with cyrillic names

I need to delete all the files in the folder.
The code runs well when file names consist of the latin letters.
It returns runtime error 52 (Bad file name or number) when any of the files contain cyrillic letters.
Surprisingly, it worked well even with cyrillic letters on my old PC.
Sub Kill1()
Dim aFile As String
aFile = "C:\Users\belose\Downloads\temp\*.*"
If Len(Dir$(aFile)) > 0 Then
Kill aFile
End If
End Sub
What could be the matter?
Solution
As per the comment from the OP, the solution was to change the regional settings...
Settings->Time and language->Addditional date time settings->Change location and chose Russia
The Dir function does not support Unicode characters. Try using the FileSystemObject instead.
The following example loops through each file in the specified folder, and then deletes any file that contains one of the specified file extensions.
Change the path to the source folder accordingly. Also, add and/or change the file extensions as desired.
Option Explicit
Sub DeleteFiles()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim sourceFolder As Object
Set sourceFolder = fso.GetFolder("c:\users\domenic\desktop") 'change the path accordingly
Dim currentFile As Object
For Each currentFile In sourceFolder.Files
Select Case fso.GetExtensionName(currentFile)
Case "txt", "csv", "xlsx", "xlsm" 'add and/or change the file extensions as desired
fso.DeleteFile currentFile.Path
End Select
Next currentFile
Set currentFile = Nothing
Set sourceFolder = Nothing
Set fso = Nothing
End Sub
I found the root cause. I have Win 10. I went to the Settings->Time and language->Addditional date time settings->Change location and chose Russia. Before I had just a similar issue with python and then I felt that it'snot the problem of the code.

Documents.Open using FileSystemObject returns "5174 - could not find the file" but not always

I want to convert all docx files in a folder to PDF.
To accomplish my goals I put all the files (only docx) in the same folder than the docm and run the macro. It worked, but now it doesn't, even with the same files doesn't work anymore. Sometimes works for the first file and stop working with the following alert:
"Runtime error '5174':
This file could not be found
(C:\Users...\Archive.docx)"
The problem is always on the Documents.Open
Tried "OpenAndRepair", "ReadOnly", Putting nothing, etc.
Sub Converter()
Dim CurrentFolder As String
Dim FileName As String
Dim myPath As String
'Store Information About Word File
myPath = ActiveDocument.FullName
FileName = Mid(myPath, InStrRev(myPath, "\") + 1)
Dim strCaminho As String
strCaminho = ActiveDocument.Path
Dim fso As Object 'Scripting.FileSystemObject
Dim fld As Object 'Scripting.Folder
Dim fl As Object 'Scripting.File
Dim atual As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(strCaminho)
For Each fl In fld.Files
If fl.Name <> FileName Then 'doesn't try to open the file with macro
Documents.Open FileName:=fl.Name
Word_ExportPDF 'A function that works
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End If
Next fl
End Sub
My code is a Frankenstein from other macros, is there a better way to Automatize this conversion?
Implement what Comintern had proposed:
You don't need to parse out the FileName - Word.Document give you direct access to that with .Name. The first thing I would do is collect the names of the documents first, then export them. You're modifying the directory contents as you iterate over it. - Comintern
Then, the following can be added to the code to check for valid document extensions:
If fl.Name <> FileName Then 'doesn't try to open the file with macro
If LCase(fso.GetExtensionName(fl.Path)) = "docx" Then '<----This Line
Documents.Open FileName:=fl.Path '<--------------------This Line
Word_ExportPDF 'A function that works
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End if
End if

VBA Read a texts files: permission denied

I have a folder contain texts files . The text is presented as below :
NAME Number Mail Date
xx 1 zz //
and I want to write a vba code that read all the text files and search for an information "NAME" to replace it with "name"and then save the modifications .
I did the code below , but I have an error 70 permission denied in Set f = FSO.OpenTextFile(Fichier, forWriting, True) ,
could you help me ?
Sub Sample()
dim fso=createobject("scripting.filesystemObject")
dim f
dim path as string
dim file_txt as string
path= "C:\Users\Folder\Fileshere\"
file_txt= Dir(path & "*.*")
Do While Len(file_txt) > 0
'Set objfile = FSO.CreateTextFile(path & file_txt)
Set f = FSO.OpenTextFile(file_txt, ForReading)
While Not f.AtEndOfStream
Namechange = f.ReadAll
Wend
Namechange = Replace(Namechange , "NAME", "name")
Set f = FSO.OpenTextFile(file_txt, forWriting, True)
f.Write Namechange
file_txt=dir()
loop
end sub
I'd rewrite using a bit more of the FileSystemObject functionality rather than using Dir() personally, but that's open to your own choice. The key issue I think you are having is that you have opened the file for reading and then immediately tried to open it for writing while the TextStream object is still in memory, and locking the file. This is why you are getting "Permission denied". To quote from a TechNet Article:
Opening Text Files
Working with text files is a three-step process.
Before you can do anything else, you must open the text file. This can
be done either by opening an existing file or by creating a new text
file. (When you create a new file, that file is automatically opened
and ready for use.) Either approach returns a reference to the
TextStream object. After you have a reference to the TextStream
object, you can either read from or write to the file. However, you
cannot simultaneously read from and write to the same file. In other
words, you cannot open a file, read the contents, and then write
additional data to the file, all in the same operation. Instead, you
must read the contents, close the file, and then reopen and write the
additional data. When you open an existing text file, the file can be
opened either for reading or for writing. When you create a new text
file, the file is open only for writing, if for no other reason than
that there is no content to read. Finally, you should always close a
text file. Although this is not required (the file will generally be
closed as soon as the script terminates), it is good programming
practice.
My code should work for your requirements. I've removed the While loop from the middle as if you are using ReadAll then you don't need to loop over the text.
Sub MySub()
Dim fso
Set fso = CreateObject("scripting.filesystemObject")
Dim file, folder
Dim path As String
Dim file_txt As String
path = "C:\users\folders\fileshere\"
Set folder = fso.GetFolder(path)
For Each file In folder.Files
Set file = fso.OpenTextFile(file.Path, 1)
Namechange = file.ReadAll
file.Close
Namechange = Replace(Namechange, "NAME", "name")
Set file = fso.OpenTextFile(file.Path, 2, True)
file.Write Namechange
file.Close
Next
End Sub
If you have any difficulties or would like further explanation of the above, let me know.
Some minor changes and it worked for me. Please change the path as per your own requirement in following code:
Sub change_txt()
Dim fso As Object
Set fso = CreateObject("scripting.filesystemObject")
Dim f
Dim path As String
Dim file_txt As String
path = "D:\Folder\Fileshare\"
file_txt = Dir(path & "*.*")
Do While Len(file_txt) > 0
'Set objfile = FSO.CreateTextFile(path & file_txt)
Set f = fso.opentextfile(path & file_txt, 1)
While Not f.AtEndOfStream
Namechange = f.ReadAll
Wend
Namechange = Replace(Namechange, "NAME", "name")
Set f = fso.opentextfile(path & file_txt, 2)
f.Write Namechange
file_txt = Dir()
Loop
End Sub

VBA excel: how to add text to all files on a folder

I need to add text string to all files on a folder, as a footer
For example, on the folder on the path and called C:\mobatchscripts\
I have a random number of txt files, with text.
I want to add a line for example "text" on each of the text files on the folder
I have little knowledge of vba programming, but for what I have read I can use append, but I need something that loop on the files on the folder, and modify them.
So far I tried this:
Sub footer()
Dim FolderPath As String
Dim FileName As String
Dim wb As Excel.Workbook
FolderPath = "C:\mobatchscripts\"
FileName = Dir(FolderPath)
Do While FileName <> ""
Open FileName For Append As #1
Print #1, "test"
Close #1
FileName = Dir
Loop
End Sub
But seems that its not looking into the files, or appending the text.
On the assumption that you're writing to text files (I see "batchscripts" in the path), you need a reference to the Microsoft Scripting Runtime (Within the VBE you'll find it in Tools, References)
Option Explicit
Public Sub AppendTextToFiles(strFolderPath As String, _
strAppendText As String, _
blnAddLine As Boolean)
Dim objFSO As FileSystemObject
Dim fldOutput As Folder
Dim filCurrent As File
Dim txsOutput As TextStream
Set objFSO = New FileSystemObject
If objFSO.FolderExists(strFolderPath) Then
Set fldOutput = objFSO.GetFolder(strFolderPath)
For Each filCurrent In fldOutput.Files
Set txsOutput = filCurrent.OpenAsTextStream(ForAppending)
If blnAddLine Then
txsOutput.WriteLine strAppendText
Else
txsOutput.Write strAppendText
End If
txsOutput.Close
Next
MsgBox "Wrote text to " & fldOutput.Files.Count & " files", vbInformation
Else
MsgBox "Path not found", vbExclamation, "Invalid path"
End If
End Sub
I'd recommend adding error handling as well and possibly a check for the file extension to ensure that you're writing only to those files that you want to.
To add a line it would be called like this:
AppendTextToFiles "C:\mobatchscripts", "Test", True
To just add text to the file - no new line:
AppendTextToFiles "C:\mobatchscripts", "Test", False
Alternatively, forget the params and convert them to constants at the beginning of the proc. Next time I'd recommend working on the wording of your question as it's not really very clear what you're trying to achieve.

VBA FileCopy: file not found issue

I am working on a project in VBA where I'm searching a directory for files of a certain date that also meet other criteria, and all of that is working fine. What I am stuck on, which should be a trivial issue, is that when I try to use FileCopy to copy the file to another folder, I keep getting a path/file access error. This confuses me because I am pulling the path directly from the FileItem I'm using to search for the criteria, I'm the person who created both the source and destination folders, and put the files in the source folder. Any thoughts?
Sub ListFilesInFolder()
Dim counter As Integer
Dim theString1 As String, theString2 As String
theString1 = "ISA*00*"
theString2 = "ISA|00|"
Dim line As String, fileName As String
Dim datestring As String
'datestring = Format(FileItem.DateLastModified, "mm/dd/yyyy")
Dim today As String
today = Format(DateAdd("d", -2, Date), "mm/dd/yyyy")
Dim destinationFolder As String
destinationFolder = "C:\Users\kragan\Desktop\test\folder2"
Dim file As TextStream
Dim FSO As Scripting.FileSystemObject
Set FSO = New Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Set SourceFolder = FSO.GetFolder("C:\Users\kragan\Desktop\test\folder1")
Dim FileItem As Scripting.file
For Each FileItem In SourceFolder.Files
datestring = "10/18/2015"
If (datestring = today) Then
Do While (SourceFolder <> "")
Set file = FSO.OpenTextFile(FileItem)
counter = 0
Do While Not file.AtEndOfLine And counter < 1
line = file.ReadLine
If InStr(1, line, theString1, vbTextCompare) > 0 Or InStr(1, line, theString2, vbTextCompare) > 0 Then
fileName = "C:\Users\kragan\Desktop\test\folder1\" + FSO.GetBaseName(FileItem) + ".AETCLS"
'The line where I get the error:
FileCopy fileName, destinationFolder
file.Close
counter = counter + 1
Exit Do
End If
Loop
Loop
End If
Next FileItem
MsgBox ("done")
End Sub
You need to specify destination folder + destination file name (and not only destination folder).
So this will work:
FileCopy fileName, destinationFolder & "\" & FSO.GetBaseName(FileItem) & ".AETCLS"
You were probably assuming this will work like a file manager application, where giving destination folder is enough... :) But when programming, you need to specify destination path exactly as it is, i.e. including the file name.
One of my friends was getting similar error on creating directory newdir1\newdir2\newdir3. It was not working despite his best effort. But the solution was to create newdir1, then it became possible to specify newdir1\newdir2, then finally newdir1\newdir2\newdir3. Programming file operations does not do the job often seen in file managers, but everything must be specified in detail and performed in elementary steps.
Thanks for your help. What I discovered is that you have to have the full destination path, including the file name, even though it isn't changing. Solved!