MS-ACCESS通过文件对话框通过vba复制文件

Question

我试图创建一个打开文件对话框的按钮，然后让您选择要复制到数据库的文件夹中的图像。我一直在使用这段代码，但是我被困在了filecopy命令中，我似乎无法正确格式化它。我使用数据库的路径加几个文件夹，最后选择一个组合框来选择特定的文件夹来创建路径（这样，如果数据库被移动，组合框就会根据类别对组合框进行排序） 。这是我一直在使用的代码。多谢你们。

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 

Answer 1

我已经回答了这个问题here但我会重新发布你

这里有一个概念

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 

您可能需要做出改变，你必须要求的Microsoft Office 12.0对象FileDialog工作的库。大部分FileDialog代码取自Microsoft。

Answer 2

使用Siddharth溃败的建议，我删除了额外的括号，并做了一些调整，瞧！代码工作。我尝试了工程师的方法，但通路不能正确生成。要修复代码本身，唯一真正的错误是对的文件副本的目标的一部分，没有文件名，所以我用

Dir(Trim(.SelectedItems.Item(1) 

要获取文件名和它上涨的结束。对于其他任何想要它的人来说，其余的代码都是这样。

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