Run-time error '52': Bad file name or number
I would like to ask for your help and suggestions as to why my code encounters a "run-time error '52': bad file name or number" when I am using a computer which do not really have access to the directory drive. I tried it on my personal computer and it showed the run-time error.
My code is working fine when I am using our company computers which have access to the directory drive. And it displays the message box "unable to access" if I try to change the folder name to make it inaccessible (for troubleshooting purposes).
What I am trying to do is actually display a message box just in case the computer used do not have any access to the directory.
I tried searching around, tried using "", 0, and vbNullString. But no success. Thank you in advance for any help.
'Check if all fields are filled up.
If Wbb.Sheets("Report").TextBox3.Value = "" Then
MsgBox "Please check missing data."
Else
'Check if drive is accessible, if not prompt a message
If Dir(filePath1, vbDirectory) = "" Then 'this is where the run-time error is pointing at
MsgBox "Unable to access drive. Please save file manually."
Exit Sub
Else
'Check if folders exists in drive. If does not exist, create folders.
If filePathCheck <> "" Then
aDirs = Split(filePathCheck, "\")
If Left(filePathCheck, 2) = "\\" Then
iStart = 3
Else
iStart = 1
End If
sCurDir = Left(filePathCheck, InStr(iStart, filePathCheck, "\"))
For i = iStart To UBound(aDirs)
sCurDir = sCurDir & aDirs(i) & "\"
If Dir(sCurDir, vbDirectory) = vbNullString Then
MkDir sCurDir
End If
Next i
End If
End If
Dir() throws an error if the left part of the directory does not exist. However the FileSystemObject simply returns False without throwing an error.
Public Function FolderExists(ByVal Path As String) As Boolean
With CreateObject("Scripting.FileSystemObject")
FolderExists = .FolderExists(Path)
End With
End Function
No reference the the Scripting.Runtime required.
Going off of what #Jeeped said in your comments, use Error Handling - [1] - [2] - [3]
On Error GoTo ErrHandler
Exit Sub
ErrHandler:
Select Case Err.Number
Case 52
MsgBox "~"
' Possibly pop up a save dialog if you desire
Err.Clear
Resume Next
Case Else
MsgBox "!"
Exit Sub
End Select
Related
I'm mapping to the company's sharepoint drive using VBA. The intention is to save local file to sharepoint, and delete local file and unmapped the drive after success.
On my machine(Windows 10 64bits), the code works perfectly fine, successfully mapped the drive, created folder and file, successfully uploaded to sharepoint and unmap the drive.
However, when I run the same excel workbook that contains the same code on my colleague's computer(Window 7), it failed. There's no error being shown, except that it keeps on loading and loading until Excel Not Responsive. I tried manually mapping the drive, it success.
I tried to debug and found out that the code stops (keeps on loading) at MsgBox "Hello" but could not figure out what's missing.
Both are using Excel 2016
Any help and suggestions are appreciated. let me know if more info is needed. Thanks in advance.
This is my vba code
Sub imgClicked()
Dim fileName As String
Dim SharePointLib As String
Dim MyPath As String
Dim folderPath As String
Dim objNet As Object
Dim copyPath As String
Dim copyFilePath As String
folderPath = Application.ThisWorkbook.path
MyPath = Application.ThisWorkbook.FullName
Dim objFSO As Object
Dim strMappedDriveLetter As String
Dim strPath As String
Dim spPath As String
strPath = "https://company.com/sites/test/test 123/" 'example path
spPath = AvailableDriveLetter + ":\test.xlsm" 'example path
copyPath = folderPath + "\copyPath\"
'Add reference if missing
Call AddReference
Set objFSO = CreateObject("Scripting.FileSystemObject")
With objFSO
strMappedDriveLetter = IsAlreadyMapped(.GetParentFolderName(strPath))
If Not Len(strMappedDriveLetter) > 0 Then
strMappedDriveLetter = AvailableDriveLetter
If Not MapDrive(strMappedDriveLetter, .GetParentFolderName(strPath)) Then
MsgBox "Failed to map SharePoint directory", vbInformation, "Drive Mapping Failure"
Exit Sub
End If
End If
' Check file/folder path If statement here
End With
Set objFSO = Nothing
End Sub
Code for getting available drive
' Returns the available drive letter starting from Z
Public Function AvailableDriveLetter() As String
' Returns the last available (unmapped) drive letter, working backwards from Z:
Dim objFSO As Object
Dim i As Long
Set objFSO = CreateObject("Scripting.FileSystemObject")
For i = Asc("Z") To Asc("A") Step -1
Select Case objFSO.DriveExists(Chr(i))
Case True
Case False
Select Case Chr(i)
Case "C", "D" ' Not actually necessary - .DriveExists should return True anyway...
Case Else
AvailableDriveLetter = Chr(i)
Exit For
End Select
End Select
Next i
Set objFSO = Nothing
MsgBox "This is the next available drive: " + AvailableDriveLetter ' returns Z drive
MsgBox "Hello" ' After this msgBox, starts loading until Not Responsive
End Function
Function to Map drive
Public Function MapDrive(strDriveLetter As String, strDrivePath As String) As Boolean
Dim objNetwork As Object
If Len(IsAlreadyMapped(strDrivePath)) > 0 Then Exit Function
Set objNetwork = CreateObject("WScript.Network")
objNetwork.MapNetworkDrive strDriveLetter & ":", strDrivePath, False
MapDrive = True
MsgBox "Successfully Created the Drive!"
Set objNetwork = Nothing
End Function
Code for MappedDrive
Public Function GetMappedDrives() As Variant
' Returns a 2-D array of (1) drive letters and (2) network paths of all mapped drives on the users machine
Dim objFSO As Object
Dim objDrive As Object
Dim arrMappedDrives() As Variant
Dim i As Long
Set objFSO = CreateObject("Scripting.FileSystemObject")
ReDim arrMappedDrives(1 To 2, 1 To 1)
For i = Asc("A") To Asc("Z")
If objFSO.DriveExists(Chr(i)) Then
Set objDrive = objFSO.GetDrive(Chr(i))
If Not IsEmpty(arrMappedDrives(1, UBound(arrMappedDrives, 2))) Then
ReDim Preserve arrMappedDrives(1 To 2, 1 To UBound(arrMappedDrives, 2) + 1)
End If
arrMappedDrives(1, UBound(arrMappedDrives, 2)) = Chr(i) ' Could also use objDrive.DriveLetter...
arrMappedDrives(2, UBound(arrMappedDrives, 2)) = objDrive.ShareName
End If
Next i
GetMappedDrives = arrMappedDrives
Set objDrive = Nothing
Set objFSO = Nothing
End Function
Public Function IsAlreadyMapped(strPath As String) As String
' Tests if a given network path is already mapped on the users machine
' (Returns corresponding drive letter or ZLS if not found)
Dim strMappedDrives() As Variant
Dim i As Long
strMappedDrives = GetMappedDrives
For i = LBound(strMappedDrives, 2) To UBound(strMappedDrives, 2)
If LCase(strMappedDrives(2, i)) Like LCase(strPath) Then
IsAlreadyMapped = strMappedDrives(1, i)
Exit For
End If
Next i
Set objNetwork = Nothing
End Function
Add Reference
Sub AddReference()
'Macro purpose: To add a reference to the project using the GUID for the
'reference library
Dim strGUID As String, theRef As Variant, i As Long
'Update the GUID you need below.
strGUID = "{420B2830-E718-11CF-893D-00A0C9054228}"
'Set to continue in case of error
On Error Resume Next
'Remove any missing references
For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
Set theRef = ThisWorkbook.VBProject.References.Item(i)
If theRef.isbroken = True Then
ThisWorkbook.VBProject.References.Remove theRef
End If
Next i
'Clear any errors so that error trapping for GUID additions can be evaluated
Err.Clear
'Add the reference
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUID, Major:=1, Minor:=0
'If an error was encountered, inform the user
Select Case Err.Number
Case Is = 32813
'Reference already in use. No action necessary
Case Is = vbNullString
'Reference added without issue
Case Else
'An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
End Select
On Error GoTo 0
End Sub
Procedure imgClicked is calling function AvailableDriveLetter multiple times. Remember that the function has to execute each time you refer to it.
I ran imgClicked (assuming that's the procedure you start with) and I was told, twice, "Next available letter = Z" and "Hello" and then it crashed Excel (perhaps getting stuck in a loop of creating FileSystem objects to look for an available drive letter?)
Try assigning AvailableDriveLetter to a variable (string) at the beginning of the procedure and referring to the variable each time you need the value, and see if you still have the issue.
(Remember to save before execution -- I get frustrated when troubleshooting "application hanging" issues because I keep forgetting to save my changes and then lose them on the crash!)
If this doesn't work, add a breakpoint (F9) on the End Function line after your "Hello" box and see if the code stops there. (I have trouble believing the MsgBox or End Function are the culprit.) If not, which procedure runs after that?
One more thing whether the issue is resolved or not:
Add Option Explicit at the very beginning of your module and then Compile the project and fix your missing variable declaration(s).
This is recommended whenever troubleshooting an issue as a means to eliminate variable declaration issues as a possible cause.
I have excel vba code that opens different files on makes use of them. An error can occur because there is no file where excel loos for it. I want to create a MsgBox on such errors with a message which specific file is absent.
Now I can only
On Error GoTo ErrorHandler
ErrorHandler:
MsgBox("File is absent")
But I can't specify which exactly file is absent. Is there a way to achieve it through error handler? Maybe through some additional variable?
EDIT: I open files through
Workbooks.Open Filename:=...
But I'm curious about what one should do if the case is
Dim fileTitle As String
filetitle=Dir()
as well.
Rather than hard-coding the file path via:
Workbooks.Open Filename:=...
Use a variable to represent the file path/name:
Dim fileName As String
fileName = "C:/path/to/my/file.xlsx"
Then, check to make sure it exists before you attempt to open it:
If FileIsAccessible(fileName) Then
' Do stuff
Else
MsgBox fileName & " doesn't exist or cannot be opened"
Exit Sub
End If
Use a custom function like
Function FileIsAccessible(path$) As Boolean
Dim FF As Long
On Error GoTo EarlyExit
FF = FreeFile
'Does file exist?
' Raises Error 53 if file not found
Open path For Input Access Read As FF
Close FF
'If file exist, is it accessible?
' Raises error 70 if file is locked/in-use
FF = FreeFile
Open path For Binary Access Write As FF
Close FF
EarlyExit:
FileIsAccessible = (Err.Number = 0)
End Function
You still have access to your variables in error handler, so you know within which file error happen:
Sub ...
Dim filename As String
On Error GoTo ErrorHandler
filename = Dir(...)
While filename>""
Set wb = Workbooks.Open(filename)
...
filename=Dir
Wend
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description & " File: " & filename
End Sub
Two ways to go about this. First, as you suggested, (which is also the easier of the two), you can make a variable that will carry the file name that you reassign after each file successfully loads. That name can then be passed into your message box in the event of a failure. If all you need to do is pass this name, this is the better solution.
The second option would be to create multiple error handlers. I would only recommend this if you need more customization with regard to how the error is handled, like wanting a different message to be displayed based on which type of file was missing. This option would make your code a good bit messier (as you would need to reassign the On Error GoTo ... statement multiple times, but its worth considering if you need a more complex solution.
Give this a try and tweak it as per your requirement. This will give you a starting point to deal with error handling....
Assuming you are trying to open a file abc.xlsx which is located at your Desktop and if this file isn't found on Desktop, the error handling will be triggered.
Don't forget to use Exit Sub before Error Handling label so that it is not executed if the file was found.
Dim wb As Workbook
Dim FilePath As String
FilePath = Environ("UserProfile") & "\Desktop\abc.xlsx"
On Error GoTo ErrorHandler
Set wb = Workbooks.Open(FilePath)
'Other stuff here if file was found and opened successfully
'
'
'
'
Exit Sub
ErrorHandler:
MsgBox Err.Number & vbNewLine & Err.Description, vbCritical, "File Not Found!"
I am checking if a file is open or not that is a .txt file
Private Sub CommandButton1_Click()
Dim strFileName As String
' Full path and name of file.
strFileName = "D:\te.txt"
' Call function to test file lock.
If Not FileLocked(strFileName) Then
' If the function returns False, open the document.
MsgBox "not open"
Else
MsgBox "open"
End If
End Sub
Function FileLocked(strFileName As String) As Boolean
On Error Resume Next
' If the file is already opened by another process,
' and the specified type of access is not allowed,
' the Open operation fails and an error occurs.
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
' If an error occurs, the document is currently open.
If Err.Number <> 0 Then
' Display the error number and description.
MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
FileLocked = True
Err.Clear
End If
End Function
It turns out .txt when opened using notepad doesn't lock the file, so it can not be known if a .txt file is open or not. And hence, if that .txt file is opened in Wordpad or Sakura, etc., your code should work or at least other code from the net should work.
I found that if a text file is opened using FileSystemObject, then the file is not locked and can still be edited by other users. As a potential workaround, you could make a file with a single bit to indicate when the other file is in use, and include checking that bit in your code. Here's my code as a rough example:
'FSO parameters
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
Sub WriteToFile()
Set fso = CreateObject("Scripting.FileSystemObject")
'Check the current lock bit (1 is locked, 0 is unlocked)
Set FileLock = fso.OpenTextFile("C:\FileLock.txt", ForReading)
Dim LockBit As Integer
LockBit = FileLock.ReadAll
FileLock.Close
'If the bit is 1 (file in use) then wait 1 second and try again (up to 10 times)
For try = 1 To 10
If LockBit = 1 Then
Application.Wait (Now + TimeValue("0:00:1"))
Set FileLock = fso.OpenTextFile("C:\FileLock.txt", ForReading)
LockBit = FileLock.ReadAll
FileLock.Close
Else: GoTo Line1 'when the bit is 0 (file available)
End If
If try = 10 Then
MsgBox "File not available"
Exit Sub
End If
Next try
Line1:
Call LockTheFile(fso, True) 'Change the lock bit to "1" to show the file's in use
Set WriteFile = fso.OpenTextFile("C:\WriteFile.txt", ForWriting)
'Do what you will with the file
MsgBox "Write Successful"
WriteFile.Close
Call LockTheFile(fso, False) 'Change the lock bit to "0" to show the file's available
End Sub
I made this sub separate to make the main code more streamlined
Sub LockTheFile(fso, SetLock As Boolean)
'Write "1" to a lock file to indicate the text file is in use, or "0" to indicate not in use
Set BitFile = fso.CreateTextFile("C:\FileLock.txt", True)
If SetLock = True Then
BitFile.WriteLine "1"
Else
BitFile.WriteLine "0"
End If
BitFile.Close
End Sub
I am trying to add a field using VBA to a table in a mdb file if the field does not exist. If I open the mdb file in Access, and run the VBA code, it works fine. However, if I clode Access, I will encounter 'Error 3265 : Item not found in this collection.' at 'With Access.Application.DBEngine(0)(0).TableDefs("Contract")' stage.
Thanks!
Here is my code:
Sub ResetDB()
Dim nlen As Long
MsgBox ("Select the Access Database using this browse button")
NewFN = Application.GetOpenFilename(FileFilter:="mdb.Files (*.mdb), *.mdb", Title:="Please select a file")
If NewFN = False Then
' They pressed Cancel
MsgBox "Try Again if database needs to be reset"
Application.DisplayAlerts = False
'ActiveWorkbook.Close
Application.DisplayAlerts = True
Exit Sub
Else
ActiveWorkbook.Unprotect ("12345")
Sheets("Version").Visible = True
Worksheets("Version").Unprotect (strPW)
Range("Database").Value = NewFN
'On Error GoTo Failed ' I comment this line just to see where the error is
' following line is when the error occurs
With Access.Application.DBEngine(0)(0).TableDefs("Contract")
.Fields.Refresh
nlen = Len(.Fields("Industry_Type").Name)
If nlen > 0 Then Sheets("Instructions").Range("a1") = 1 ' do nothing
End
End With
Failed:
If Err.Number = 3265 Then Err.Clear ' Error 3265 : Item not found in this collection.
With Access.Application.DBEngine(0)(0).TableDefs("Contract")
.Fields.Append .CreateField("Industry_Type", dbLong)
End With
End
End If
End Sub
If the Access is closed, you will not be able to work on it.
You must open the MDB file:
Dim db As New Access.Application
db.OpenAccessProject filepath
The use db to retrieve the tables:
db.TableDefs....
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.