Question

我有一个允许用户添加文件的表单和一个列出这些添加文件的列表框：

Private Sub cmdFileDialog_Click()
' Add Files button
' Using this to open the File Dialog box and save attachment file location paths

   Dim fDialog As Office.FileDialog
   Dim varFile As Variant
   Dim varFileName As String

' Set up the File dialog box.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
  ' Allow the user to make multiple selections in the dialog box.
      .AllowMultiSelect = True

  ' Set the title of the dialog box.
      .Title = "Select One or More 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 loops through each file that is selected and then add it to the list box.
        'For Each varFile In .SelectedItems
        '   Me.FileList.AddItem varFile
        'Next

     ' This loops through each file that is selected and adds the entire file's path to the invisible list.
     ' Will use this invisible list to save locations of any attachments to this record in the ideaAttachmentPath field in tblIdeaDetails
        For Each varFile In .SelectedItems
           Me.InvisiblePathList.AddItem varFile
        Next

  ' This goes through each selected file and extracts just file's name rather than full path name (accomplished above)
  ' and adds file names to list box
     For Each varFile In .SelectedItems
         varFileName = Dir(varFile)
         Me.FileList.AddItem varFileName
         attachmentsAdded = True
     Next

     Me.ClearListBoxButton.Visible = True
     Me.AttachedLabel.Visible = True
     Me.FileList.Visible = True
  End If
End With

End Sub

我希望完成的是在用户点击按钮（特别是“保存”按钮）后将这些添加的文件保存到网络文件夹中。如何循环浏览文件列表框并将这些文件复制到网络文件夹中？这是我到目前为止所做的：

Function SaveAttachments()
    Dim fileName As Variant
    Dim fileDestination As String
    Dim attachment As Integer

    For attachment = 0 To Me.FileList.ListCount
        'MsgBox (FileList.ItemData(x))
        FileList.ItemData(attachment).Text = fileName
        'build the destination
        fileDestination = "path here"
        'copy the file to the new folder
        FileCopy fileName, fileDestination
    Next

End Function

Answer 1

我认为这就是你要找的东西：

Sub SaveAttachments()

    Dim fileDestination As String
    Dim i As Long

    'Update this to the correct folder, be sure to include the ending \
    fileDestination = "Drive:\Path\To\Folder\"

    For i = 0 To Me.FileList.ListCount - 1
        FileCopy Me.InvisiblePathList.ItemData(i) & Application.PathSeparator & Me.FileList.ItemData(i), fileDestination & Me.FileList.ItemData(i)
    Next i

End Sub

从Access列表框中保存附件？

1 个答案: