2017-01-03 5 views
0

Недавно я начал экспериментировать с vba для автоматизации некоторых моих ежедневных задач в Microsoft Word. Я работаю над кодом, который позволит пользователю выбрать папку назначения, а также файлы (.doc), которые будут скопированы в выбранную папку назначения.Скопируйте файл в файл microsoft в другую папку с помощью vba

Следующий код работает без ошибок, однако файлы не копируются в папку назначения.

Я буду признателен за любую помощь в решении этой проблемы.

С уважением,

Дерек

Sub copydocs() 

Dim items As Long 
Dim file_path As Variant 
Dim folder_path As Variant 

    'Ask user for input' 

    items = InputBox("Give me some input") 


    'Select Destination Folder 
    With Application.FileDialog(msoFileDialogFolderPicker) 
     folder_path = .SelectedItems(1) 
     .Show 
    End With 


    ' Open the file dialog 
    For i = 1 To items 
     With Application.FileDialog(msoFileDialogFilePicker) 
      .AllowMultiSelect = True 
      .Show 
      file_path = .SelectedItems(1) 
     End With 

     ' Copy paste  
     Dim fs As Object 
     Set fs = CreateObject("Scripting.FileSystemObject") 
     fs.CopyFile file_path, folder_path 
     Set fs = Nothing 

    Next i  

End Sub 

ответ

0

Есть несколько вопросов.

Переменная i не объявлена ​​нигде.

Вы пытаетесь сохранить путь к папке до того, как диалог вернет ее.

Sub copydocs() 
    Dim i As Integer    ' CHANGE: New declare. 
    Dim fs As Object    ' CHANGE: Moved to top. 
    Dim items As Long 
    Dim file_path As Variant 
    Dim folder_path As Variant 

    'Ask user for input. 
    items = InputBox("Give me some input") 

    'Select Destination Folder 
    With Application.FileDialog(msoFileDialogFolderPicker) 
     ' CHANGE: Switched order of next two lines. 
     .Show 
     folder_path = .SelectedItems(1) 
    End With 

    ' Open the file dialog 
    For i = 1 To items 
     With Application.FileDialog(msoFileDialogFilePicker) 
      .AllowMultiSelect = True 
      .Show 
      file_path = .SelectedItems(1) 
     End With 

     ' Copy paste 
     Set fs = CreateObject("Scripting.FileSystemObject") 
     fs.CopyFile file_path, folder_path 
     Set fs = Nothing 
    Next i 
End Sub