VBA Dir function not working on Excel 2010 - vba

I mapped an intranet location using the File Explorer. i.e. mapped http://intranet.XXXXXXX.com/mydir/ to M:\
I'm using the Dir function to test if a file is present in that location:
Dim FileExists as Boolean
FileExists = Dir("M:\myfile") <> ""
If FileExists Then MsgBox "File found in M:"
I run that macro on Excel 2007 and it Works Fine. When I run it on Excel 2010 though, Dir("M:\myfile") always returns "", even if the file is present in the specified location. I can´t find a solution that will work on both Excel versions. Any ideas?

You may add file extension as a wildcard character at the end of filepath. I gave a try in excel 2010 and it worked for me.
Dim FileExists As Boolean
FileExists = Dir("D:\myfile" & "*.txt") <> ""
If FileExists Then MsgBox "File found in M:"

I found that if I use the full network name, it works first go. This wasn't just in VBA, but also some shortcuts also - they returned "File could not be found".
Changing from the mapped shortcut, e.g.
Y:\Projects\Proj1\File1.xlsx
to the full mapped path, e.g.
\\server\Department\Projects\Proj1\File1.xlsx
Fixed the problem

Here is how to use FSO to do what you want:
Option Explicit
Function test_it()
'Test the Function - must pass the file path and name
Debug.Print Does_File_Exist("C:\temp\form1.txt")
End Function
Private Function Does_File_Exist(sFullPath) As Boolean
' Will return True or False if file exists.
' Provide the fully qualified path and file name.
' You can disable the MsgBox displays after testing
Dim oFs As New FileSystemObject
Dim oFile As File
Set oFs = New FileSystemObject
If oFs.FileExists(sFullPath) Then
Does_File_Exist = True
MsgBox "Found file: " & sFullPath
Else
Does_File_Exist = False
MsgBox "File not found: " & sFullPath
End If
Set oFs = Nothing
End Function

Related

How to open two types of documents in one folder?

I frequently run a macro on folders that contain .doc and .docx files. Currently, my macro is only able to edit one type of file and then I have to change my macro from .doc to .docx (or vice versa) and run again.
How could I get both file types in one go?
The current code.
'UpdateDocuments
Sub UpdateDocuments()
Dim file
Dim path As String
'Path to your folder.
'make sure to include the terminating "\"
‘Enter path.
path = "C:\Users\emckenzie\Documents\TEMP PLOT\macro practice\Andria footer change\"
'Change this file extension to the file you are opening
file = Dir(path & "*.docx")
Do While file <> ""
Documents.Open FileName:=path & file
'This is the call to the macro you want to run on each file the folder
'Enter macro.
Call Permit2hundred
' Saves the file
ActiveDocument.Save
ActiveDocument.Close
'set file to next in Dir
file = Dir()
Loop
End Sub
To answer your question:
Use a wildcard like * or ? in this line: fileExtension = "*.doc?"
You can read more about wildcard characters here
Some suggestions on your code:
Assign variable types when you're defining them
Indent your code (You can use www.rubberduckvba.com)
Define your variables close to where you first use them (matter of preference)
When working with documents, assign them to a document variable and refer to that variable instead of ActiveDocument
Use basic error handling
Additional tip:
When calling this procedure Permit2hundred you could pass the targetDocument variable like this:
'This is the call to the macro you want to run on each file the folder
'Enter macro.
Permit2hundred targetDocument
' Saves the file
targetDocument.Save
And the definition of that procedure could be something like this:
Private Sub Permit2hundred(ByVal targetDocument as Document)
'Do something
End Sub
This is the refactored code:
Public Sub UpdateDocuments()
' Add basic Error handling
On Error GoTo CleanFail
'Path to your folder.
'make sure to include the terminating "\"
'Enter path.
Dim folderPath As String
folderPath = "C:\Users\emckenzie\Documents\TEMP PLOT\macro practice\Andria footer change\"
'Change this file extension to the file you are opening
Dim fileExtension As String
fileExtension = "*.doc?"
' Get files in folder
Dim fileName As String
fileName = Dir(folderPath & fileExtension)
' Loop through files in folder
Do While file <> vbNullString
Dim targetDocument As Document
Set targetDocument = Documents.Open(fileName:=folderPath & file)
'This is the call to the macro you want to run on each file the folder
'Enter macro.
Permit2hundred
' Saves the file
targetDocument.Save
targetDocument.Close
'set file to next in Dir
file = Dir()
Loop
CleanExit:
Exit Sub
CleanFail:
MsgBox "Something went wrong. Error: " & Err.Description
GoTo CleanExit
End Sub
Let me know if it works
I prefer to display a file picker dialog and then select what I want. I am then able to choose a doc or docx file without having to alter my code. The Filter property determines the file types allowed. Note that this code clears the filter when it ends, otherwise that is the filter Word will use from that point on, even for manually initiated (non-programmatic) requests of File Open.
This example is setup to allow multiple selections. You can change the AllowMultiSelect to False and then the code will run with only one file at a time.
Dim i As Integer, selFiles() As String
Dim strFolderPath As String, Sep As String
Sep = Application.PathSeparator
Erase selFiles
'Windows Office 2019, 2016, 2013, 2010, 2007
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select the files to update"
.InitialFileName = curDir
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "All Word Files", "*.docx; *.docm; *.doc", 1
If .Show = 0 Then
Exit Sub
End If
ReDim Preserve selFiles(.SelectedItems.Count - 1)
strFolderPath = Left(.SelectedItems(1), InStrRev(.SelectedItems(1), Sep))
For i = 0 To .SelectedItems.Count - 1
selFiles(i) = .SelectedItems(i + 1)
Next
.Filters.Clear
End With

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.

msaccess - storing sql query in external file

I dislike the built in text editor for MsAccess and would like to use an external text editor.
Expanding on a previous question: msaccess - sql view - autocomplete / intellisense or alternate way to write queries?
Is there a way I can store the sql query in an external file and have MsAccess reference it?
If you are OK with setting the recordsource via VBA, then you can use this:
Public Function ReadTxt(filePath As String) As String
Dim oFSO As FileSystemObject
Set oFSO = New FileSystemObject
Dim oFS As TextStream
If oFSO.FileExists(filePath) Then
On Error GoTo Err
Set oFS = oFSO.OpenTextFile(filePath)
' read file
ReadTxt = oFS.ReadAll
'Debug.Print IIf(oFS Is Nothing, "file is closed", "file opened")
oFS.Close
Else
MsgBox "The file path is invalid.", vbCritical, vbNullString
Exit Function
End If
Exit Function
Err:
MsgBox "Error while reading the file.", vbCritical, vbNullString
oFS.Close
Exit Function
End Function
Usage: ReadTxt("C:\TempFolder\YourQuery.txt")
However, it's a lot of fiddling around, why not just cut and paste it (the SQL) into Access?

VBA "Check if folder exists" works only when there is a file in the folder

I got the original code from www.rondebruin.nl
It is designed to test whether or not a folder already exists in the directory. I modified it to fit my needs and it seemed to work well.
Today, i discovered that it only works properly if the folder being tested for is NOT empty. If it is empty, then it returns false (i.e. the folder does not exist).
I can't figure out why this is.
FolderPath = sPfad
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
TestStr = ""
On Error Resume Next
TestStr = Dir(FolderPath)
On Error GoTo 0
If TestStr = "" Then
Test_Folder_Exist_With_Dir = False
Exit Function
Else
Test_Folder_Exist_With_Dir = True
Exit Function
End If
I suspect the answer lies in the TestStr = Dir(FolderPath) but haven't been able to get to the bottom of it. The MSDN article basically explains that Dir() always returns something. However the examples give are all such that there is a file present to return.
I basically need to get it so that it recognizes the folder regardless of whether there is something in it or not.
Any help appreciated!
The following line returns a number greater than 0 if the folder exists, regardless of whether the folder has any files in it
len(dir("C:\Users\user\Desktop\Tests\tt", vbDirectory))
You could try this instead:
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(FolderPath)
...

Delete all files within a directory vb6

I was wondering if anyone could help me with a vb6 function that would delete all files within a directory (excluding subdirectories).
One line, using the VB6 statement Kill
Kill "c:\doomed_dir\*.*"
The help topic says "In Microsoft Windows, Kill supports the use of multiple-character (*) and single-character (?) wildcards to specify multiple files".
As an aside - I prefer to avoid the Microsoft Scripting Runtime (including FileSystemObject). In my experience it's occasionally broken on user machines, perhaps because their IT department are paranoid about viruses.
I believe this should work:
Dim oFs As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File
If oFs.FolderExists(FolderSpec) Then
Set oFolder = oFs.GetFolder(FolderSpec)
'caution!
On Error Resume Next
For Each oFile In oFolder.Files
oFile.Delete True 'setting force to true will delete a read-only file
Next
DeleteAllFiles = oFolder.Files.Count = 0
End If
End Function
I haven't tested every scenario but it should work. It should delete every file and if the file is locked or you don't have access you should get Error 70 which is caught and you get an Abort, Retry or Ignore box.
Sub DeleteAllFilesInDir(ByVal pathName As String)
On Error GoTo errorHandler
Dim fileName As String
If Len(pathName) > 0 Then
If Right(pathName, 1) <> "\" Then pathName = pathName & "\"
End If
fileName = Dir(pathName & "*")
While Len(fileName) > 0
Kill pathName & fileName
fileName = Dir()
Wend
Exit Sub
errorHandler:
If Err.Number = 70 Then
Select Case MsgBox("Could not delete " & fileName & ". Permission denied. File may be open by another user or otherwise locked.", vbAbortRetryIgnore, "Unable to Delete File")
Case vbAbort:
Exit Sub
Case vbIgnore:
Resume Next
Case vbRetry:
Resume
End Select
Else
MsgBox "Error deleting file " & fileName & ".", vbOKOnly Or vbCritical, "Error Deleting File"
End If
End Sub
It would seem that the Scripting runtime FileSystemObject's DeleteFile method also supports wildcards as this works for me:
Dim fs As New Scripting.FileSystemObject
fs.Deletefile "C:\Temp\*.jpg", true
This approach has less control than the approach suggested by #Corazu, but may have some utility in certain cases.