I have the following code:
Public Function get_workbook() As String
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Title = "Please select the file."
fd.Show
get_workbook = fd.SelectedItems(1)
End Function
This works. However, if the user closes the dialog box once opened, there is an:
"Invalid procedure call or argument" error thrown.
How would I go about handling this error?
So for example, rather than that error being thrown, the function simply exits.
EDIT:
I use this code to get the user to open a file which also works.
Dim wb as Workbook
Set wb = Workbooks.Open(get_workbook(), ReadOnly:=True)
Add in an error handler. I used a select case so you can add other errors should they occur.
Public Function get_workbook() As String
On Error GoTo errcatch
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Title = "Please select the file."
fd.Show
get_workbook = fd.SelectedItems(1)
on error goto 0
Exit Function 'Stop code from going into error handler without an error
errcatch:
Select Case Err.Number 'Do something based on error number
Case 5
on error goto 0
Exit Function
End Select
End Function
Related
I have a drop-down menu assigned to a shape, i use it to open others workbooks, but these are shared workbooks, so i want VBA to tell me when the workbook i selected are being used by another user and dont open it, because I need it to be opened in edit mode.
Menu:
My code so far:
Sub MenuSuspenso()
Application.CommandBars("Cell").Reset
Dim cbc As CommandBarControl
For Each cbc In Application.CommandBars("cell").Controls
cbc.Visible = False
Next cbc
With Application.CommandBars("Cell").Controls.Add(temporary:=True)
.Caption = "AQUAS"
.OnAction = "AQUAS"
End With
End Sub
Sub AQUAS()
Dim book As Workbook
Set book = "\\T\Public\DOCS\Hualley\FLUXO CAIXA HINDY - 111.xlsm"
If book.ReadOnly = True Then
MsgBox ("Arquivo em Uso")
book.Close()
app.Quit()
Else
Workbooks.Open ("\\T\Public\DOCS\Hualley\FLUXO CAIXA HINDY - 111.xlsm"), True
End Sub
The book comes from a server drive, and have links ( true for UpdateLinks ) and macros.
Please, try the next function. It or its other versions exist on internet from some years. I mean, I am not the one designing it, but I do not know where from I have it:
Function IsWorkBookOpen(FileName As String) As Boolean
Dim fileCheck As Long, ErrNo As Long
On Error Resume Next
fileCheck = FreeFile()
Open FileName For Input Lock Read As #fileCheck
Close fileCheck
ErrNo = err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
Now, how to use it...
Firstly, this part of your code is wrong:
Dim book As Workbook
Set book = "\\T\Public\DOCS\Hualley\FLUXO CAIXA HINDY - 111.xlsm"
This should be declared as String, not being Set and check if the workbook is open in the next way:
Sub AQUAS()
Dim bookPath As String, bookWb As Workbook
bookPath = "\\T\Public\DOCS\Hualley\FLUXO CAIXA HINDY - 111.xlsm"
'check if its full name is correct:
If Dir(bookPath) = "" Then MsgBox "The supplied workbook name is wrong...": Exit Sub
If IsWorkBookOpen(bookPath) Then
MsgBox ("Arquivo em Uso")
Else
Set bookWb = Workbooks.Open(bookPath)
Debug.Print bookWb.Sheets.count 'it returns the number of sheets for the open workbook...
'Here do whatever you need with the workbook.
End If
End Sub
I'm looking to have primary workbook (WorkbookA), open a second workbook (WorkbookB) and test for a value within it. Value to match is in WorkbookA, cell B3 and is the number 1. Range to test in WorkbookB is "A:A".
If the value is not found, WorkbookB is reopened for the user to edit (will optimize to reduce opening/closing, any ideas on getting user input to resume would be appreciated after editing Workbook B), and the code in WorkbookA loops and retests if WorkbookB is still open every 10 seconds.
After the user edits WorkbookB to ensure the value is present, they close it (any better way to signal they are complete is welcomed so I don';t have to close and reopen the files. They are small, so it's not an issue for speed, just seems inefficient).
The assumption I had was that the code would then detect the workbook was closed and then continue code execution, but the VBA is stopping as soon as I select the X in the top right corner of Workbook B.
Would prefer not having separate code in personal.xls file because of multiple users.
Thanks,
Aaron
Code in Workbook A:
Global Const strWBb As String = "C:\Users\ashepherd\Desktop\WorkbookB.xlsx"
Global Const strRng As String = "A:A"
Sub Validate()
' ***************************** CHECK WORKBOOKB FOR 1 IN COLUMN A:A *****************************
' Verify presence on item in second workbook
searchItem = ThisWorkbook.Worksheets("Sheet1").Range("B3").Value
Do While Verify(searchItem, False) = False
Call Verify("", True)
Do While IsWorkBookOpen(strWBb) = True
endTime = DateAdd("s", 10, Now())
Do While Now() < endTime
DoEvents
Loop
Loop
Debug.Print "Workbook closed"
Loop
Debug.Print "search item found"
End Sub
Function Verify(item, OpenOnly As Boolean) As Boolean
' ****************************************************************************
' Open workbook B and verify that presence of item
' ****************************************************************************
Dim wbVerify As Workbook
Dim rng1 As Range
' ************************** OPEN FILE ************************************************
If IsFile(strWBb) Then
Set wbVerify = Application.Workbooks.Open(FileName:=strWBb, UpdateLinks:=False, IgnoreReadOnlyRecommended:=True) ' Open WorkbookB
wbVerify.Worksheets("Sheet1").Select
Else
MsgBox " File path incorrect. Unable to open.", vbCritical
Exit Function
End If
' ************************** TEST FOR ITEM ************************************************
If OpenOnly = True Then ' Only opening the file for read/write. Not testing values.
MsgBox "Opening workbook so values can be added. Close when additions completed."
Else
MsgBox ("Workbook B opened. Testing value for " & item & " in column A:A in Workbook B")
Set rng1 = Range(strRng).Find(item, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
MsgBox item & " found !"
Verify = True
wbVerify.Close
GoTo item_found
Else
MsgBox (item & " not found in column A:A. Closing Workbook B. *****User will be promoted at this point to exit, or re-open the file to modify the values so search value is found in column A:A. Code SHOULD resume when Workbook B is closed. Currently VBA code execution in Workbook A is stopping when the 'X' is selected in top right window of Workbook B*****")
Verify = False
wbVerify.Close
End If
End If
Normal_exit:
Exit Function
item_found:
MsgBox "Verify code complete"
GoTo Normal_exit
End Function
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
Function IsFile(ByVal fName As String) As Boolean
'Returns TRUE if the provided name points to an existing file.
'Returns FALSE if not existing, or if it's a folder
On Error Resume Next
IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function
Final code:
Global Const strWBb As String = "C:\Users\ashepherd\Desktop\WorkbookB.xlsx"
Global Const strRng As String = "A:A"
Global Complete As Boolean
Sub Validate()
' ***************************** CHECK WORKBOOK_B FOR 1 IN COLUMN A:A *****************************
' Verify presence on item in second workbook
searchItem = ThisWorkbook.Worksheets("Sheet1").Range("B3").Value
Do While Verify(searchItem) = False
Complete = False
UserForm1.Show vbModeless ' USerform has a single button which changes the global "Complete" variable to true
Do While Complete = False
DoEvents
Loop
UserForm1.Hide
Debug.Print "Manual Edit Complete, retesting"
Loop
End Sub
Function Verify(item) As Boolean
' Modified to close only upon finding search item vs. reopening it.
' ****************************************************************************
' Open workbook B and verify that presence of item
' ****************************************************************************
Dim wbVerify As Workbook
Dim rng1 As Range
' ************************** OPEN FILE ************************************************
If IsFile(strWBb) Then
Set wbVerify = GetWorkbook(strWBb)
If Not wbVerify Is Nothing Then
Debug.Print wbVerify.Name
End If
wbVerify.Worksheets("Sheet1").Select
Else
MsgBox " File path incorrect. Unable to open.", vbCritical
Exit Function
End If
' ************************** TEST FOR ITEM ************************************************
Set rng1 = Range(strRng).Find(item, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
Verify = True
GoTo item_found
Else
MsgBox (item & " not found in column A:A. A pop up form will show. Edit document and then hit RESUME button to continue checking. DO NOT exit via the close icon in the top right window of Excel as the code will stop running.")
Verify = False
End If
Normal_exit:
Exit Function
item_found:
'MsgBox (item & " found in WorkbookB, column A:A. Verify code complete")
wbVerify.Close Savechanges:=True
GoTo Normal_exit
End Function
Function IsFile(ByVal fName As String) As Boolean
'Returns TRUE if the provided name points to an existing file.
'Returns FALSE if not existing, or if it's a folder
On Error Resume Next
IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function
Public Function GetWorkbook(ByVal sFullName As String) As Workbook
' https://stackoverflow.com/questions/9373082/detect-whether-excel-workbook-is-already-open, modified to add ignorereadonly and update links
Dim sFile As String
Dim wbReturn As Workbook
sFile = Dir(sFullName)
On Error Resume Next
Set wbReturn = Workbooks(sFile)
If wbReturn Is Nothing Then
Set wbReturn = Application.Workbooks.Open(FileName:=sFullName, UpdateLinks:=False, IgnoreReadOnlyRecommended:=True)
End If
On Error GoTo 0
Set GetWorkbook = wbReturn
End Function
This Program is Supposed to Open A whole lot of Workbooks, the One at the top of the list (filename1, AKA Plan) is a place to upload many different cells of data, every other opened workbook is functionally the same. The file opening present no issues.
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim fd As FileDialog
Dim FileName1 As String
Dim Plan, Leg As Workbook
Dim FileChosen As Integer
Dim CUILT As String
Dim CuiltRange As Range
Set fd = Application.FileDialog(msoFileDialogOpen)
FileChosen = fd.Show
fd.InitialView = msoFileDialogViewList
fd.AllowMultiSelect = True
fd.Filters.Clear
fd.Filters.Add "Plan Excel", "*.xlsx"
fd.Filters.Add "Leg Excel, "*.xlsm"
fd2.FilterIndex = 1
If FileChosen <> -1 Then
MsgBox "The Operation has been stopped"
Else
FileName1 = fd2.SelectedItems(1)
Workbooks.Open (FileName1)
Set Plan = ActiveWorkbook
For i = 2 To fd2.SelectedItems.Count
Workbooks.Open fd2.SelectedItems(i)
Set Leg = ActiveWorkbook
CUILT = Leg.Sheets(1).Range("I19").Value
Plan.Worksheets(1).Activate
Now comes the part of the code that's giving me trouble, with the help of some other post I was able to navigate through the finicky nature of the find:Variable function, but right after I was able to sort that error, the "Found Range Variable = Range" now just doesn't want to cooperate. It gives me error 91, it's as if CuiltRow is not actually saving any value in the previous Set operation, even when I try to MsgBox after "Set" to figure it out, if just tells me its not defined, Every other out I've tried has ended in
error 438 "object doesn't support property or method".
Set CuiltRow = Plan.Sheets(1).Range("C16:C421").Find(CUILT, LookIn:=xlValues, LookAt:=xlWhole)
CuiltRow.Offset(0, 5).Range("A1").Value = Leg.Sheets(1).Range("D14").Value
The Set CuiltRow wont work without the Set, and I know the set is the one causing the 91? Honestly, im at a loss, Any help Would be Appreciated!
Next i
'Else
'End If
MsgBox "Operation has been completed"
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End If
End Sub
I Just want to use the range CuiltRow returns as a reference waypoint to set many offsets, but with my poor syntax in "Range(offset) = Range" function VBA believes I'm trying to set a Value into a Range Object, how can I express it differently so its clear?
I have a dialog box to pick a folder name and display the name of the folder that the user selects.
If the user selects cancel instead of folder path and OK, it throws an error.
I used a status variable and noticed that upon cancel the status changes to -1. So I tried to implement the code that is in comment section using a if condition to exit the sub.
That doesn't work in the case of selecting a folder when the commented part is present in the code.
Without that it works in selecting a folder.
sub abc()
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Title = "Select a folder then hit OK"
diaFolder.Show
'Status = diaFolder.Show
'If Status < 0 Then
'Exit Sub
'End If
a = diaFolder.SelectedItems(1)
MsgBox ("Folder selected is :" & a)
ens sub
Keep in mind that vbFalse = 0 and vbTrue = -1.
In other words clicking 'OK' would return -1 and clicking 'Cancel' would return 0.
Try the following code:
Sub abc()
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Select a folder then hit OK"
If .Show = -1 Then
MsgBox ("Folder selected is :" & .SelectedItems(1))
Else
Exit Sub
End If
End With
End Sub
Sub abc()
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Title = "Select a folder then hit OK"
Dim status As Integer
status = diaFolder.Show
If status <> -1 Then
MsgBox "Cancel Chosen"
Exit Sub
End If
a = diaFolder.SelectedItems(1)
MsgBox ("Folder selected is :" & a)
End Sub
I know this is closed out but wanted to try posting for the first time. =D
If there are no items selected, *SelectedItems(1)*doesn't exist, and Excel will return an error. That's what's happening when the user presses the Cancel button.
A solution for this is to check how many items are selected using the structure below:
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
'Optional: limits the user to choosing a single option. Necessary if you want to avoid an error because the user selected multiple files.
.Title = "Dialog Title" 'Changing the title is also Optional
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Canceled by user" 'or just do nothing!
Else
MyVar = .SelectedItems(1)
End If
'Alternatively, "if .selecteditems.count = 1 then myvar = .selecteditems(1)" can be used
End With
Sub test()
thesentence = InputBox("Type the filename with full extension", "Raw Data File")
Range("A1").Value = thesentence
If Dir("thesentence") <> "" Then
MsgBox "File exists."
Else
MsgBox "File doesn't exist."
End If
End Sub
In this when i pickup the text value from the input box, it doesn't work. If however, if remove "the sentence" from If Dir() and replace it with an actual name in the code, it works. Can somebody help?
Note your code contains Dir("thesentence") which should be Dir(thesentence).
Change your code to this
Sub test()
thesentence = InputBox("Type the filename with full extension", "Raw Data File")
Range("A1").Value = thesentence
If Dir(thesentence) <> "" Then
MsgBox "File exists."
Else
MsgBox "File doesn't exist."
End If
End Sub
Use the Office FileDialog object to have the user pick a file from the filesystem. Add a reference in your VB project or in the VBA editor to Microsoft Office Library and look in the help. This is much better than having people enter full paths.
Here is an example using msoFileDialogFilePicker to allow the user to choose multiple files. You could also use msoFileDialogOpen.
'Note: this is Excel VBA code
Public Sub LogReader()
Dim Pos As Long
Dim Dialog As Office.FileDialog
Set Dialog = Application.FileDialog(msoFileDialogFilePicker)
With Dialog
.AllowMultiSelect = True
.ButtonName = "C&onvert"
.Filters.Clear
.Filters.Add "Log Files", "*.log", 1
.Title = "Convert Logs to Excel Files"
.InitialFileName = "C:\InitialPath\"
.InitialView = msoFileDialogViewList
If .Show Then
For Pos = 1 To .SelectedItems.Count
LogRead .SelectedItems.Item(Pos) ' process each file
Next
End If
End With
End Sub
There are lots of options, so you'll need to see the full help files to understand all that is possible. You could start with Office 2007 FileDialog object (of course, you'll need to find the correct help for the version you're using).
Correction to fileExists from #UberNubIsTrue :
Function fileExists(s_directory As String, s_fileName As String) As Boolean
Dim obj_fso As Object, obj_dir As Object, obj_file As Object
Dim ret As Boolean
Set obj_fso = CreateObject("Scripting.FileSystemObject")
Set obj_dir = obj_fso.GetFolder(s_directory)
ret = False
For Each obj_file In obj_dir.Files
If obj_fso.fileExists(s_directory & "\" & s_fileName) = True Then
ret = True
Exit For
End If
Next
Set obj_fso = Nothing
Set obj_dir = Nothing
fileExists = ret
End Function
EDIT: shortened version
' Check if a file exists
Function fileExists(s_directory As String, s_fileName As String) As Boolean
Dim obj_fso As Object
Set obj_fso = CreateObject("Scripting.FileSystemObject")
fileExists = obj_fso.fileExists(s_directory & "\" & s_fileName)
End Function
just get rid of those speech marks
Sub test()
Dim thesentence As String
thesentence = InputBox("Type the filename with full extension", "Raw Data File")
Range("A1").Value = thesentence
If Dir(thesentence) <> "" Then
MsgBox "File exists."
Else
MsgBox "File doesn't exist."
End If
End Sub
This is the one I like:
Option Explicit
Enum IsFileOpenStatus
ExistsAndClosedOrReadOnly = 0
ExistsAndOpenSoBlocked = 1
NotExists = 2
End Enum
Function IsFileReadOnlyOpen(FileName As String) As IsFileOpenStatus
With New FileSystemObject
If Not .FileExists(FileName) Then
IsFileReadOnlyOpen = 2 ' NotExists = 2
Exit Function 'Or not - I don't know if you want to create the file or exit in that case.
End If
End With
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileReadOnlyOpen = 0 'ExistsAndClosedOrReadOnly = 0
Case 70: IsFileReadOnlyOpen = 1 'ExistsAndOpenSoBlocked = 1
Case Else: IsFileReadOnlyOpen = 1 'Error iErr
End Select
End Function 'IsFileReadOnlyOpen
Function FileExists(fullFileName As String) As Boolean
FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
End Function
Works very well, almost, at my site. If I call it with "" the empty string, Dir returns "connection.odc"!! Would be great if you guys could share your result.
Anyway, I do like this:
Function FileExists(fullFileName As String) As Boolean
If fullFileName = "" Then
FileExists = False
Else
FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
End If
End Function
Function FileExists(fullFileName As String) As Boolean
FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
End Function
I'm not certain what's wrong with your code specifically, but I use this function I found online (URL in the comments) for checking if a file exists:
Private Function File_Exists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean
'Code from internet: http://vbadud.blogspot.com/2007/04/vba-function-to-check-file-existence.html
'Returns True if the passed sPathName exist
'Otherwise returns False
On Error Resume Next
If sPathName <> "" Then
If IsMissing(Directory) Or Directory = False Then
File_Exists = (Dir$(sPathName) <> "")
Else
File_Exists = (Dir$(sPathName, vbDirectory) <> "")
End If
End If
End Function
Very old post, but since it helped me after I made some modifications, I thought I'd share. If you're checking to see if a directory exists, you'll want to add the vbDirectory argument to the Dir function, otherwise you'll return 0 each time. (Edit: this was in response to Roy's answer, but I accidentally made it a regular answer.)
Private Function FileExists(fullFileName As String) As Boolean
FileExists = Len(Dir(fullFileName, vbDirectory)) > 0
End Function
based on other answers here I'd like to share my one-liners that should work for dirs and files:
Len(Dir(path)) > 0 or Or Len(Dir(path, vbDirectory)) > 0 'version 1 - ... <> "" should be more inefficient generally
(just Len(Dir(path)) did not work for directories (Excel 2010 / Win7))
CreateObject("Scripting.FileSystemObject").FileExists(path) 'version 2 - could be faster sometimes, but only works for files (tested on Excel 2010/Win7)
as PathExists(path) function:
Public Function PathExists(path As String) As Boolean
PathExists = Len(Dir(path)) > 0 Or Len(Dir(path, vbDirectory)) > 0
End Function