I am trying to use msoFileDialogOpen to retrieve the corresponding filename the user selected. Here is my clumsy code so far:
Public Sub Function3_FileExplorer()
' Start File Explorer to select file containing data (simple GUI, much easier than coding vFileName)
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
If .Show Then
Dim file As Variant
For Each file In .SelectedItems
.SelectedItems Path
End If
End With
ErrorHandler:
MsgBox "Error detected" & vbNewLine & "Error" & Err.Number & Err.Line
Err.Description , vbCritical, "Error Handler: Error " & Err.Number
End Sub
When I run this program I get the error message:
Compile error:
Invalid use of property
I think using property .SelectedItems is the right thing to do here but I'm not sure how to take that filename and store it as a variant.
EDIT: the revised code (does this do what I want it to do?)
Public Sub Function3_FileExplorer()
Dim file As Variant
' Start File Explorer to select file containing data (simple GUI, much easier than coding vFileName)
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
If .Show Then
file = .SelectedItems(1)
Path = file
End If
End With
MsgBox file
Exit Sub
ErrorHandler:
MsgBox "Error detected" & vbNewLine & "Error" & Err.Number & _
Err.Description, vbCritical, "Error Handler: Error " & Err.Number
End Sub
This is basically what you want (it's not clear what you really want to do with the file name):
Public Sub Function3_FileExplorer()
Dim file As Variant
' Start File Explorer to select file containing data (simple GUI, much easier than coding vFileName)
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
If .Show Then
file = .SelectedItems(1)
End If
End With
MsgBox file
Exit Sub
ErrorHandler:
MsgBox "Error detected" & vbNewLine & "Error" & Err.Number & _
Err.Description, vbCritical, "Error Handler: Error " & Err.Number
End Sub
Related
Using Microsoft Access: there is a form. On the form is a textbox containing a name. There is a button on the form which, when clicked, runs vba code that looks at the name on the form then opens the like named folder. The database and folder reside in the same directory. Two users have reported that, instead of the folder opening, Internet Explorer opens for them (to their default webpage).
Code for the button:
Private Sub cmdNewOpenFolder_Click()
'Uses the OpenFolderMod module to open the folder for the active record in file explorer, and create
'one if it doesn't yet exist
On Error GoTo Err_Handler
If Me.chkComplete = True Then
MsgBox "This folder has been moved to the archive"
Exit Sub
Else:
Call OpenFolder(Me.FullName)
End If
Exit_Handler:
Exit Sub
Err_Handler:
If err.Number = 94 Then
MsgBox "Please add the name of the fugitive in the 'Name' text box in order" & vbCrLf & _
"for a folder to be created."
Else
MsgBox "Error " & err.Number & ": " & err.Description
End If
Resume Exit_Handler
End Sub
The Open Folder code:
Public Sub OpenFolder(fldName As String)
Dim strStartFilePath As String
Dim strEndFilePath As String
Dim Continue As String
On Error GoTo err
strStartFilePath = strBEPath & "\" & fldName
strEndFilePath = Dir(strStartFilePath & fldName & "*", vbDirectory)
Application.FollowHyperlink strStartFilePath & strEndFilePath
err:
If err.Number = 490 Then
Continue = MsgBox("There is no folder yet, do you want to create one?", _
vbYesNo, "Create Folder")
If Continue = vbYes Then
Call MakeFolder(strBEPath & "\" & fldName)
Application.FollowHyperlink strStartFilePath & strEndFilePath
Else: Exit Sub
End If
End If
End Sub
strBEPath is a constant that is the backend database location on a shared server. It looks like "\\{name of server}\{otherfoldername}\{otherfoldername with a space in the name}\etc." (there are five subfolders in all.)
Interestingly, there is a similar button which opens the "Project Folder" the folder with the database and subfolder and it works just fine:
Public Sub OpenProjFolder()
Application.FollowHyperlink strBEPath
'Debug.Print strBEPath
End Sub
I looked over the machines where this is happening and nothing looks out of the ordinary. Both users have all the right reference libraries and so on.
Any ideas as to why Internet Explorer is opening?
I have googled everywhere but I am unable to find out to do it without rewriting all the code, is there anyway to have this code check whether the file name matches table names and if it does then clear that table and re import or if not then create a new table?
Option Compare Database
Option Explicit
Private Sub btnBrowse_Click()
Dim diag As Office.FileDialog
Dim item As Variant
Set diag = Application.FileDialog(msoFileDialogFilePicker)
diag.AllowMultiSelect = False
diag.Title = "Please select an Excel Spreadsheet"
diag.Filters.Clear
diag.Filters.Add "Excel Spreadsheets", "*.xls, *.xlsx, *.xlsm"
If diag.Show Then
For Each item In diag.SelectedItems
Me.txtFileName = item
Next
End If
End Sub
Private Sub btnImportSpreadsheet_Click()
Dim FSO As New FileSystemObject
If FSO.FileExists(Nz(Me.txtFileName, "")) Then
ImportExcelSpreadsheet Me.txtFileName, FSO.GetFileName(Me.txtFileName)
ElseIf Nz(Me.txtFileName, "") = "" Then
MsgBox "Please select a file!", vbExclamation
Else
MsgBox "File not found!", vbExclamation
End If
End Sub
Public Sub ImportExcelSpreadsheet(Filename As String, TableName As String)
On Error Resume Next
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, TableName, Filename, True
If Err.Number = 3125 Then
If vbOK = MsgBox(Err.Description & vbNewLine & vbNewLine & "Skip column header and continue?", vbExclamation + vbOKCancel, "Error with Excel Column header") Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, TableName, Filename, False
MsgBox "Done", vbInformation
End If
Exit Sub
ElseIf Err.Number <> 0 Then
MsgBox Err.Number & ":" & Err.Description, vbCritical
Exit Sub
End If
MsgBox "Upload Complete", vbInformation
End Sub
Thank for any help
You'll have to rewrite some. Without looping through Tables collection and testing against each name, every method seems to involve handling an error. Here is one:
Function TableExists(strTableName As String) As Boolean
On Error Resume Next
TableExists = IsObject(CurrentDb.TableDefs(strTableName))
End Function
Call the function:
If TableExists("YourTableName") = True Then
More examples in How to check if a table exists in MS Access for vb macros
My code is suppose to check cell j2 for an email address and if found, convert that specific tab to pdf and save it in a file path that the user chooses. It works fine on the original workbook I made the macro in. When I copy the code and try running it, it prints to pdf different sheets that don't even have anything in j2 with the incorrect tab name. I keep getting an Run time error 5 Invalid procedure call or argument when i run the code on the print pdf line.
Sub SaveSheetsAsPDF()
Dim DestFolder As String
Dim PDFFile As String
Dim wb As Worksheet
Dim AlwaysOverwritePDF As Boolean
'Speed up macro
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Prompt for file destination
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
DestFolder = .SelectedItems(1)
Else
MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
Exit Sub
End If
End With
'Create new PDF file name including path and file extension
For Each wb In ThisWorkbook.Worksheets
'Test j2 for a mail address
If wb.Range("J2").Value Like "?*#?*.?*" Then
PDFFile = DestFolder & Application.PathSeparator & wb.Name & "-" & Format(Date, "mmyy") & ".pdf"
'If the PDF already exists
If Len(Dir(PDFFile)) > 0 Then
If AlwaysOverwritePDF = False Then
OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
'If you want to overwrite the file then delete the current one
If OverwritePDF = vbYes Then
Kill PDFFile
Else
MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Else
On Error Resume Next
Kill PDFFile
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If
End If
'Prints PDF
wb.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next wb
MsgBox "All Files Have Been Converted!"
ResetSettings:
'Resets optimization settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Edit: Also not all worksheets on the workbook will need to converted. So only the sheets that need to be converted will have the email address in J2.
The following code checks if file is open, if not, it opens it and copies something into it. It works fine on my computer. Will it work, when the file is shared and another user opens the file? Will my code detect it?
Sub copy_to_boss()
On Error Resume Next
team = "boss.xlsm"
Set fileBoss = Workbooks(team)
fileIsOpen = Not fileBoss Is Nothing
If fileIsOpen = True Then
MsgBox "The following file is open " & team & " - close it."
Else
MsgBox "I will open the following file " & team
Workbooks.Open Filename:=team
ActiveWorkbook.Worksheets("List1").Cells(1, 1).Value = "10"
End If
End Sub
Try this:
Sub test_LockFile()
Dim sFile As String
Dim sLockFile As String
Dim objFSO As Object
'Trick: Each Excel file in use has a temporary file companion with prefix "~$"
' (e.g. "test.xlsm" ... "$~test.xlsm")
'Define sLockFile
sFile = ThisWorkbook.Name
sLockFile = ThisWorkbook.Path & "\~$" & sFile
'FileSystemObject, late Binding ohne Nutzung von IntelliSense und autom. Konstanten
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Show message if file is locked
If objFSO.FileExists(sLockFile) Then
MsgBox "The file " & sLockFile & " is locked by some user.", vbInformation, sFile & " is locked"
Else
MsgBox "The file is available", vbInformation, sFile
End If
End Sub
You can use something like this to check if the file is in use:
Public Function IsFileLocked(PathName As String) As Boolean
On Error GoTo ErrHandler
Dim i As Integer
If Len(Dir$(PathName)) Then
i = FreeFile()
Open PathName For Random Access Read Write Lock Read Write As #i
Lock i 'Redundant but let's be 100% sure
Unlock i
Close i
Else
Err.Raise 53
End If
ExitProc:
On Error GoTo 0
Exit Function
ErrHandler:
Select Case Err.Number
Case 70 'Unable to acquire exclusive lock
IsFileOpen = True
Case Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
End Select
Resume ExitProc
Resume
End Function
I am trying to make this msoFileDialogOpen allow the user to select multiple files. Is there a better way to do this:
Public Sub Function3_FileExplorer()
' Start File Explorer to select file containing data (simple GUI, much
' easier than coding vFileName)
vuserChoiceDataFileNumber = InputBox("Enter the number of files you want to select.")
With Application.FileDialog(msoFileDialogOpen)
Select Case IsNumeric(vuserChoiceDataFileNumber)
Case True
If VarType(vuserChoiceDataFileNumber) = 2 Or 3 Then
iuserChoiceDataFileNumber = CInt(vuserChoiceDataFileNumber)
End If
Case False
MsgBox (vuserChoiceDataFileNumber & " is not an integer.")
.AllowMultiSelect = False
End Select
.Show
End With
Exit Sub
On Error GoTo ErrorHandler
.AllowMultiSelect = True
ErrorHandler:
MsgBox "Error detected" & vbNewLine & "Error" & Err.Number & ": " & _
Err.Description, vbCritical, "Error Handler: Error " & Err.Number
MsgBox "If you want to force the program to run, go to the line below and " & _
"insert a ' mark to comment the line out." & vbNewLine & _
"On Error GoTo ErrorHandler", vbCritical, "Error Handler: Error " & Err.Number
End Sub
Yes, you can make this much simpler by not asking the user how many files they want to open--just let them select as many as they want.
Public Sub Function3_FileExplorer()
' Start File Explorer to select file containing data (simple GUI, much easier than coding vFileName)
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.FilterIndex = 2
If .Show Then
Dim file As Variant
For Each file In .SelectedItems
' do something with the file, for example, open it:
Application.Workbooks.Open (file)
Next file
End If
End With
End Sub