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

时间:2013-12-11 00:55:04

标签: vba ms-access filedialog

我正在尝试创建一个打开文件对话框的按钮,然后让您选择要复制到数据库的文件夹中的图像。我一直在使用这段代码,但我坚持使用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

2 个答案:

答案 0 :(得分: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 Object Library for FileDialog才能运行。大部分FileDialog代码都来自Microsoft

答案 1 :(得分:1)

使用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