As the title states my msgbox within my userform is stuck in an infinite loop.
I decided to include every command button code there is on this form in case it will help to solve this problem. Also there is also one textbox as well. I've tried various types of loops except the For Loop because every For Loop example I have seen has a counter or some form of increment formula.
What I would like to happen in my loop is if the user clicks on the command button labeled open and txtbxSelectFile.value = "" then display the message box and keep doing this every time the cmdbtnOpen_Click is true and txtbxSelectFile.value = "".
The only thing that came close to working, was the If ... Then conditional statement but it would not loop. It would only run once and then continued to the Else condition. Or maybe a better explanation would be if the user keeps clicking the open button and there is nothing in the textbox then keep displaying the message box.
The value from the textbox is supposed to come from a file browse button. When the user clicks the browse button a file dialog opens so the user can locate the file they want to open.
Private Sub cmdBrowse_Click()
'myFile = Application.GetOpenFilename(, , "Select a File.")
Dim fname As String
Dim fpath As String
fpath = ThisWorkbook.Path
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = fpath
.ButtonName = "Get File Name"
.Title = "File Selection"
.Filters.Clear
.Filters.Add "Excel Files", "*.xl; *.xlsx; *.xlsm; *.xlb; *.xlam; *.xltx; *.xltm; *.xls; *.xla; *.xlt; *.xlm; *.xlw"
.AllowMultiSelect = False
If .Show = True Then
fname = .SelectedItems(1)
Me.txtbxSelectFile.Text = fname
Else
MsgBox "Operation Canceled"
Unload Me
End If
End With
End Sub
Private Sub cmdbtnOpen_Click()
Do While txtbxSelectFile = ""
MsgBox "Please Select a file", vbOKOnly, "No File Selected"
Loop
Workbooks.Open Me.txtbxSelectFile
Unload Me
selectRangefrm.Show
End Sub
I really hope my explanation makes sense. Thank you.
How about a slightly different approach? Why not make the .Enabled property of the Open button dependent upon the value of txtbxSelectFile?
That way, the Open button can't be pressed until a value sits in txtbxSelectFile.
In design mode, change the property of the Open button: set .Enabled to False and then use:
Private Sub cmdBrowse_Click()
'myFile = Application.GetOpenFilename(, , "Select a File.")
Dim fname As String
Dim fpath As String
fpath = ThisWorkbook.Path
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = fpath
.ButtonName = "Get File Name"
.Title = "File Selection"
.Filters.Clear
.Filters.Add "Excel Files", "*.xl; *.xlsx; *.xlsm; *.xlb; *.xlam; *.xltx; *.xltm; *.xls; *.xla; *.xlt; *.xlm; *.xlw"
.AllowMultiSelect = False
If .Show = True Then
fname = .SelectedItems(1)
Me.txtbxSelectFile.Text = fname
Else
MsgBox "Operation Canceled"
End If
cmdbtnOpen.Enabled = Me.txtbxSelectFile.Text <> ""
End With
End Sub
Private Sub cmdbtnOpen_Click()
Workbooks.Open Me.txtbxSelectFile
Unload Me
selectRangefrm.Show
End Sub
Related
I have this code (in Form_Before_update Event) which checks for duplicate values in sdtCode field:
If DCount("[sdtCode]", "[tbl_sdt_Info]", "[sdtCode] = '" & Me.sdtCode.Value & "'") > 0 Then
Me.Undo
MsgBox "duplicates found"
End If
It works perfectly. However, after I use the following code to link the record to a picture, and when I try to move to another record the fisrst code is triggered and it gives me the "duplicates found" message!!!!
Private Sub sdtPicture_Click()
Dim fd As FileDialog
Dim i As Integer
Dim strSelectedPicture As Variant
Dim strExtension As String
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.AllowMultiSelect = False
'show only set of extension file in dialog
.Filters.Clear
.Filters.Add "Image file", "*.jpeg;*.png;*.jpg;*.gif", 1
If .Show = -1 Then
For Each strSelectedPicture In .SelectedItems
For i = Len(strSelectedPicture) To 1 Step -1
If Mid(strSelectedPicture, i, 1) = "." Then
strExtension = Mid(strSelectedPicture, i)
Exit For
End If
Next i
Me.sdtImagePath.Value = strSelectedPicture
' if folder name doesnt exist then make new one
On Error Resume Next
MkDir "C:\dbImageArchive\students\"
' On Error GoTo 0
'if folder exist, copy image to distination folder
'file name in the drive C:\
FileCopy strSelectedPicture, "C:\dbImageArchive\students\" & "sdt_" & Me.sdtCode & strExtension
Me.sdtPicturePath.Value = "C:\dbImageArchive\students\" & "sdt_" & Me.sdtCode.Value & strExtension
'Add a text box (sdtPictureName) to display the name of the picture file
'Me.sdtPictureName = Me.sdtID & strExtension
Next strSelectedPicture
Else
'display when no file is selected
MsgBox "?? E?II ???C?", vbInformation, ""
End If
Set fd = Nothing
End With
Me.cboOrganizations.SetFocus
'Me.Refresh
End Sub
I tried the Form_after_update event. It produced further problems. Any ideas to solve this issue please. Thank you.
I'm using Excel 2010. I have an Excel macro-enabled template that has a data connection to a text file that is set to automatically refresh when a new document is created using this template.
The following macro is within the "ThisWorkbook" object to remove the data connection before saving the new document:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Do While ActiveWorkbook.Connections.Count > 0
ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
Loop
End Sub
When a user clicks the save icon / hits ctrl+S, inputs a filename and then clicks save to save as a macro-free Excel workbook (as is the default and required filetype) they are prompted with a message stating:
The following features cannot be saved in macro-free workbooks:
• VB project
To save a file with these features, click No, and then choose a
macro-enabled file type in the File Type list.
To continue saving as a macro-free workbook, click Yes.
Is it possible to prevent this message from appearing and have Excel assume that the user wants to continue with a macro-free workbook?
I've searched all over and understand that I may be able to add code to the workbook object that removes itself so that Excel has no VB project to cause this message but this would require each user to change Trust Center Settings (Trust access to the VBA project object model) which I want to avoid.
I've also seen suggestions of using:
Application.DisplayAlerts = False
but can't get this to work. Every example of it's use seems to be within a sub that is also handling the saving of the document whereas in my situation the BeforeSave sub ends before the document is saved in the default, non-vba way which is perhaps why it does not work?
Does this property reset to a default True after the sub has ended / before the save actually occurs?
Apologies for any nonsense I may have dispensed, my experience with VBA is very limited.
I cannot test on Excel 2010, but at least for 2016, it's working fine:
Sub SaveAsRegularWorkbook()
Dim wb As Workbook
Dim Path As String
Set wb = ThisWorkbook
Path = "T:\he\Path\you\prefer\"
Application.DisplayAlerts = False
Application.EnableEvents = False
wb.SaveAs Filename:=Path & "Test.xlsx", FileFormat:=51
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Give it a try.
Different approach... when the template is loaded, require the user to save as (I have a workbook/template with a similar situation...). This should open them up to the user's Documents folder, though you can adjust to save to whatever location.
Inside of the ThisWorkbook module, put:
Option Explicit
Private Sub Workbook_Open()
Dim loc As Variant
Application.DisplayAlerts = False
loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\NAME_OF_FILE")
If loc <> False Then
ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
Exit Sub
End If
Application.DisplayAlerts = True
End Sub
Edit1: Adding the if statement using a base-template name, so subsequent saves do not prompt the save-as:
Option Explicit
Private Sub Workbook_Open()
If ActiveWorkbook.Name = "_NAME_OF_FILE.xlsb" Then
Dim loc As Variant
Application.DisplayAlerts = False
loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\_NAME_OF_FILE")
If loc <> False Then
ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
Exit Sub
End If
Application.DisplayAlerts = True
End If
End Sub
For this answer, I'm assuming that by Excel macro-enabled template, you mean a xltm file. I also guess that what you mean by "new document" is the document that is generated when a user double-clicks on the xtlm file (hence this new file has no location on since it hasn't been saved yet).
To solve your issue, you could use a custom SaveAs window (Application.GetSaveAsFilename) to have more control on how the user saves the file when the Workbook_BeforeSave event macro gets called.
Here is how to implement it:
1 - Copy this code into a new module.
Option Explicit
Sub SaveAsCustomWindow()
Const C_PROC_NAME As String = "SaveAsCustomWindow"
Dim strFullFileName As String, strPreferedFolder As String, strDefaultName As String
Dim UserInput1 As Variant, UserInput2 As Variant
Dim isValidName As Boolean, isFileClosed As Boolean, isWorkbookClosed As Boolean
Dim strFilename As String, strFilePath As String
'To avoid Warning when overwriting
Application.DisplayAlerts = False
'Disable events (mostly for the BeforeSave event) to avoid creating infinite loop
Application.EnableEvents = False
On Error GoTo ErrHandler
'Customizable section
strDefaultName = ThisWorkbook.Name
strPreferedFolder = Environ("USERPROFILE")
Do While isWorkbookClosed = False
Do While isFileClosed = False
Do While isValidName = False
UserInput1 = Application.GetSaveAsFilename(InitialFileName:=strPreferedFolder & "\" & strDefaultName, FileFilter:="Excel Workbook (*.xlsx),*.xlsx")
If UserInput1 = False Then
GoTo ClosingStatements 'This is important to take care of the case when the user presses cancel
Else
strFullFileName = UserInput1
End If
strFilename = Right(strFullFileName, Len(strFullFileName) - InStrRev(strFullFileName, "\"))
strDefaultName = strFilename
strFilePath = Left(strFullFileName, InStrRev(strFullFileName, "\") - 1)
strPreferedFolder = strFilePath
'If the file exist, ask for overwrite permission
If Dir(strFullFileName) <> "" Then
UserInput2 = MsgBox(strFilename & " already exists." & vbNewLine & "Do you want to overwrite?", vbYesNoCancel Or vbExclamation)
If UserInput2 = vbNo Then
isValidName = False
ElseIf UserInput2 = vbYes Then
isValidName = True
ElseIf UserInput2 = vbCancel Then
GoTo ClosingStatements
Else
GoTo ClosingStatements
End If
Else
isValidName = True
End If
Loop
'Check if file is actually open
If isFileOpen(strFullFileName) Then
MsgBox "The workbook you want to overwrite is currently open. Choose a different name, or close the workbook before saving.", vbExclamation
isValidName = False
isFileClosed = False
Else
isFileClosed = True
End If
Loop
'Check if an opened workbook has the same name
If isWorkbookOpen(strFilename) Then
MsgBox "You cannot save this workbook with the same name as another open workbook or add-in. Choose a different name, or close the other workbook or add-in before saving.", vbExclamation
isValidName = False
isFileClosed = False
isWorkbookClosed = False
Else
isWorkbookClosed = True
End If
Loop
ThisWorkbook.SaveAs Filename:=strFullFileName, FileFormat:=xlOpenXMLWorkbook
ClosingStatements:
Application.EnableEvents = True
Application.DisplayAlerts = True
Exit Sub
ErrHandler:
Call MsgBox("Run-time error '" & Err.Number & "': " & Err.Description & vbNewLine & _
"While running: " & C_PROC_NAME & IIf(Erl <> 0, vbNewLine & "Error Line: " & Erl, "")
GoTo ClosingStatements
End Sub
Function isFileOpen(ByVal Filename As String) As Boolean
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: isFileOpen = False
Case 70: isFileOpen = True
End Select
End Function
Function isWorkbookOpen(ByVal Filename As String) As Boolean
Dim wb As Workbook, ErrNo As Long
On Error Resume Next
Set wb = Workbooks(Filename)
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: isWorkbookOpen = True
Case Else: isWorkbookOpen = False
End Select
End Function
Explanation of part 1: This whole thing might seem a bit overkill, but all the error handling is important here to take into account potential errors and make sure that the setting for Application.EnableEvents is turned back to TRUE even if an error occurs. Otherwise, all event macros will be disabled in your Excel application.
2 - Call the SaveAsCustomWindow procedure inside the Workbook_BeforeSave event procedure like this:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Your code
If ThisWorkbook.Path = "" Then
SaveAsCustomWindow
Cancel = True
End If
End Sub
Note that we need to set the variable Cancel = True in order to prevent the default SaveAs window to show up. Also, the if statement is there to make sure that the custom SaveAs window will only be used if the file has never been saved.
To answer your questions:
Is it possible to prevent this message from appearing?
Yes, using the Application.DisplayAlerts property
Is it possible to have Excel assume that the user wants to continue with a macro-free workbook?
No, you have to write the procedure to save the workbook and bypass the SaveAs excel event and save the workbook using the user input (Path & Filename) with the required format.
The following procedure uses a FileDialog to capture the Path and Filename from the user then saves the file without displaying the warning message.
I have added some explanatory comments nevertheless, let me know of any questions you might have.
Copy these procedures in the ThisWorkbook module:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True 'Prevents repetitive Save
Call Workbook_BeforeSave_ApplySettings_And_Save
End Sub
Private Sub Workbook_BeforeSave_ApplySettings_And_Save()
Dim fd As FileDialog, sFilename As String
Rem Sets FileDialog to capture user input
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.InitialView = msoFileDialogViewDetails
.Title = vbNullString 'Resets default value in case it was changed
.ButtonName = vbNullString 'Resets default value in case it was changed
.AllowMultiSelect = False
If .Show = 0 Then Exit Sub 'User pressed the Cancel Button
sFilename = .SelectedItems(1)
End With
With ThisWorkbook
Do While .Connections.Count > 0
.Connections.Item(.Connections.Count).Delete
Loop
Application.EnableEvents = False 'Prevents repetition of the Workbook_BeforeSave event
Application.DisplayAlerts = False 'Prevents Display of the warning message
On Error Resume Next 'Prevents Events and Display staying disable in case of error
.SaveAs Filename:=sFilename, FileFormat:=xlOpenXMLWorkbook 'Saves Template as standard excel using user input
If Err.Number <> 0 Then
MsgBox "Run-time error " & Err.Number & String(2, vbLf) _
& Err.Description & String(2, vbLf) _
& vbTab & "Process will be cancelled.", _
vbOKOnly, "Microsoft Visual Basic"
End If
On Error GoTo 0
Application.DisplayAlerts = True
Application.EnableEvents = True
End With
End Sub
I have a macro that asks a user to choose multiple files for data analysis. User selects a Excel or CSV file first (XLSX, XLS, CSV), then asks for a second file but CSV only. The intent of the tool is to combine the two data files into one.
In one Sub, I ask the user to select any compatible XLSX, XLS, or CSV files using the FileDialog code:
Dim myObj As Object
Dim myDirString As String
Set myObj = Application.FileDialog(msoFileDialogFilePicker)
With myObj
.InitialFileName = "C:\Users\" & Environ$("Username") & "\Desktop"
.Filters.Add "Custom Excel Files", "*.xlsx, *.csv, *.xls"
.FilterIndex = 1
If .Show = False Then MsgBox "Please select Excel file.", vbExclamation: Exit Sub
myDirString = .SelectedItems(1)
End With
It seems to filter appropriately:
After this data analysis in complete, then the user runs a second sub to select another file, but it must be a CSV file only. So I use this code to request CSV:
Dim yourObj3 As Object
Dim yourDirString3 As String
Set yourObj3 = Application.FileDialog(msoFileDialogFilePicker)
With yourObj3
.InitialFileName = "C:\Users\" & Environ$("Username") & "\Desktop"
.Filters.Add "CSV Files", "*.csv"
.FilterIndex = 1
If .Show = False Then MsgBox "Please select CSV file.", vbExclamation: Exit Sub
yourDirString3 = .SelectedItems(1)
End With
The problem is the FileDialog box remembers the first filter (Custom XLS) and they need to click the drop down to see the appropriate filter for CSV only...
So this would certainly be confusing to the user...I'm guessing I need to "clear" our that first filter after the user completes the first macro. Any suggestions on that code to clear (or reset) the first filter?
Tried adding this below it when I found what I thought was a similar question FileDialog persists previous filters:
With .Filters
.Clear
End With
But results in Compile error: Invalid or unqualified reference
This works in my environment. The only thing I made differently was to declare dialogs as FileDialog instead of Object.
Sub Test()
Dim myObj As FileDialog
Dim myDirString As String
Set myObj = Application.FileDialog(msoFileDialogFilePicker)
With myObj
.InitialFileName = "C:\Users\" & Environ$("Username") & "\Desktop"
.Filters.Clear
.Filters.Add "Custom Excel Files", "*.xlsx, *.csv, *.xls"
.FilterIndex = 1
.Show
End With
Dim yourObj3 As FileDialog
Dim yourDirString3 As String
Set yourObj3 = Application.FileDialog(msoFileDialogFilePicker)
With yourObj3
.InitialFileName = "C:\Users\" & Environ$("Username") & "\Desktop"
.Filters.Clear
.Filters.Add "CSV Files", "*.csv"
.FilterIndex = 1
.Show
End With
End Sub
Although it is not directly the answer to the specific msoFileDialogFilePicker from the OP (and googled this answer), I had the same problem with the msoFileDialogSaveAs dialog in Excel 2010 where errors are raised trying to modify the filters in any way because it obviously is not supported :-/
The msoFileDialogSaveAs dialog does NOT support file filters
I keep getting an error in this code saying "End If without Block If". I've looked at it and can't see the problem, printed it out and connected all the If statements to their joining End If, and everything looks right.
Is something else throwing e off, like that With/End With block?
Private Sub cmd__Import_Eligibility_Click()
' Requires reference to Microsoft Office 11.0 Object Library.
Dim fDialog As FileDialog
Dim varFile As Variant
Dim filelen As Integer
Dim filename As String
Dim tblname As String
' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
fDialog.InitialFileName = "oo*.*"
With fDialog
' Set the title of the dialog box.
.Title = "Please select a file"
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Excel Spreadsheets", "*.xls*"
.Filters.Add "Comma Separated", "*.CSV"
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to our list box.
varFile = fDialog.SelectedItems(1)
If Right(varFile, 4) = ".xls" Or Right(varFile, 5) = ".xlsx" Then
'get only file name
For a = Len(varFile) To 1 Step -1
If Mid(varFile, 1) = "\" Then
filelen = a
End If
Exit For
filename = Right(varFile, filelen)
tblname = Left(filename, InStr(filename, ".") - 1)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, tblname, filename, True
End If 'ERRORS OUT ON THIS LINE ==========================
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
As Scott posted as a comment, your For...Next loop construct is malformed:
For a = Len(varFile) To 1 Step -1
If Mid(varFile, 1) = "\" Then
filelen = a
End If
Exit For
There's no such thing as a For...Exit For loop. You mean to do this:
For a = Len(varFile) To 1 Step -1
If Mid(varFile, 1) = "\" Then
filelen = a
Exit For
End If
Next
Otherwise the compiler is seeing [roughly] this:
If [bool-expression] Then
For [for-loop-setup]
If [bool-expression] Then
[instructions]
End If
Exit For
[instructions]
End If '<~ expecting "Next" before that "End If" token.
Running an auto-indenter would have made this problem obvious, I think. I happen to manage an open-source project that ported the popular Smart Indenter VBE add-in to .NET, so that it can run in 64-bit environments. See rubberduckvba.com for all the features.
I'm trying to create a button that opens up a file dialog, then lets you select a image to copy into a folder with the database. I've been working with this code but I'm stuck at the filecopy command, I can't seem to format it correctly. I use the pathway of the database plus a few folders then finally a combo box to select the specific folder to create the pathway (so that it doesn't break if the database is moved, and the combo box sorts the images based on category). Here's the code I've been using. Thanks guys.
Private Sub Command156_Click()
Dim fDialog As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim varFile As Variant
' Set up the File Dialog. '
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = [Application].[CurrentProject].[Path]
With fDialog
' Allow user to make multiple selections in dialog box '
.AllowMultiSelect = False
' Set the title of the dialog box. '
.Title = "Please select a Image"
' Clear out the current filters, and add our own.'
.Filters.Clear
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the '
' user picked at least one file. If the .Show method returns '
' False, the user clicked Cancel. '
If .Show = True Then
filecopy([.SelectedItems],[GetDBPath] & "\Images\Equipment\" & Combo153)
Else
End If
End With
End Sub
Using Siddharth routs suggestion, I removed the extra brackets and made a few tweaks and voila! the code worked. I tried engineersmnky method but the pathway wasn't generating correctly. To fix the code itself, the only real error was that on the destination part of the file copy, there was no file name, So I used
Dir(Trim(.SelectedItems.Item(1)
To get the file name and tacked it on the end. Heres the rest of the code for anyone else who wants it.
Private Sub Command156_Click()
Dim fDialog As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim varFile As Variant
' Set up the File Dialog. '
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = Application.CurrentProject.Path
With fDialog
' Allow user to make multiple selections in dialog box '
.AllowMultiSelect = False
' Set the title of the dialog box. '
.Title = "Please select a Image"
' Clear out the current filters, and add our own.'
.Filters.Clear
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the '
' user picked at least one file. If the .Show method returns '
' False, the user clicked Cancel. '
If .Show = True Then
' This section takes the selected image and copy's it to the generated path'
' the string takes the file location, navigates to the image folder, uses the combo box selection to decide the file category, then uses the name from the filedialog to finish the path'
FileCopy .SelectedItems(1), Application.CurrentProject.Path & "\Images\Equipment\" & Combo153 & "\" & Dir(Trim(.SelectedItems.Item(1)))
Else
End If
End With
End Sub
I have answered this question here but I'll repost for you
Here is a concept
Sub Locate_File()
Dim fDialog As Office.FileDialog
Dim file_path As String
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
'Set the title of the dialog box.
.Title = "Please select one or more files"
'Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "All Files", "*.*"
'Show the dialog box. If the .Show method returns True, the
'user picked at least one file. If the .Show method returns
'False, the user clicked Cancel.
If .Show = True Then
file_path = .SelectedItems(1)
Copy_file file_path,Combo153
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End
Sub Copy_file(old_path As String, file_name As String)
Dim fs As Object
Dim images_path As String
images_path = CurrentProject.Path & "\Images\Equipment\"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile old_path, images_path & file_name
Set fs = Nothing
End
You may need to make changes and you must require the Microsoft Office 12.0 Object Library for FileDialog to work. Much of the FileDialog code was taken from Microsoft.