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

我在這里回答了這個問題，但我會轉發給你

這是一個概念

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 Object Library for FileDialog才能工作。 大多數FileDialog代碼都來自Microsoft 。

Answer 2

使用Siddharth潰敗的建議，我刪除了額外的括號，做了一些調整，瞧！ 代碼工作。 我嘗試了engineermnky方法，但路徑沒有正確生成。 要修復代碼本身，唯一真正的錯誤是在文件副本的目標部分，沒有文件名，所以我使用

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