1、在引用中勾选Microsoft Office 11.0 Object Library
2、在模块中写一个自定义函数:
Function GetFolder(w As Boolean) As String
'引用:Microsoft Office 11.0 Object Library
'功能:打开文件夹,返回文件名或返回文件夹名。
'参数:w=true 查找文件;w=false 查找文件夹
Dim dlgOpen As FileDialog
Dim i As Long, j As Long
If w = True Then
Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)
Else
Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)
End If
With dlgOpen
.AllowMultiSelect = True
.Show
End With
If dlgOpen.SelectedItems.Count > 0 Then
GetFolder = GetFolder & dlgOpen.SelectedItems(1)
Else
GetFolder = ""
End If
Set dlgOpen = Nothing
End Function
3、在图片另存为按钮中写如下代码:
Private Sub Command14_Click()
Dim strpath As String
Dim strname As String
strpath = GetFolder(False)
strname = Mid(Me.图片地址.Value, InStrRev(Me.图片地址.Value, "\") + 1)
strname = strpath & "\" & strname
FileCopy Me.图片地址.Value, strname
End Sub