Пользовательская форма VBA для копирования PDF-файлов из выбранных папок - PullRequest
Новая
       26

Пользовательская форма VBA для копирования PDF-файлов из выбранных папок

0 голосов
/ 16 апреля 2019

Мы импортируем файл CSV в Excel из Creo, это наш список материалов, мы создаем файлы чертежей в формате PDF и DXF и сохраняем их в двух папках «MASTER».При выдаче чертежей производителю мы должны скопировать каждый отдельный чертеж в отдельную папку перед отправкой.

Решение, над которым я работаю, заключается в использовании пользовательской формы для выбора местоположения «copyfrom» и «copyto»,на кнопке «Выполнить» подпрограмма должна копировать файлы.

Я использовал использованный код копирования, введя расположение папок в подпрограмме Sub, но мне нужно разрешить другим пользователям выбирать другие файлы,Пользовательская форма добавляет расположение папок в определенные текстовые поля, но следующая подпрограмма для копирования файлов PDF не будет работать.

Я думаю, что это может быть значение текстового поля не записано?

КакКроме того, я хотел бы вернуть количество перемещенных PDF-файлов как часть сообщения в окне сообщения после завершения процедуры.Это может отличаться от количества используемых ячеек в столбце B

Номер детали чертежа всегда будет в столбце B

Я еще не создал опцию DXF, но она будетбыть очень похожим на PDF, если я смогу заставить его работать

Любая и вся помощь очень ценится. 

Private Sub cmdclose_Click()
Unload Me
End Sub

Private Sub copyfromcmd_Click()

Dim fldr As FileDialog
Dim sItem As String

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = Application.DefaultFilePath
    '.InitialFileName = Application.GetSaveAsFilename()
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
    End With
    NextCode:
    GetFolder = sItem
    copyfromtb.Value = sItem

Set fldr = Nothing


End Sub

Private Sub copytocmd_Click()

Dim fldr As FileDialog
Dim sItem2 As String

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = Application.DefaultFilePath
    '.InitialFileName = Application.GetSaveAsFilename()
    If .Show <> -1 Then GoTo NextCode
    sItem2 = .SelectedItems(1)

End With
NextCode:
GetFolder = sItem2
copytotb.Value = sItem2

Set fldr = Nothing

End Sub

Private Sub runcmd_Click()
  Dim R As Range
  Dim SourcePath As String, DestPath As String, FName As String


  'Setup source and dest path (Note: must have a trailing backslash!)
  SourcePath = Me.copyfromtb.Value
  DestPath = Me.copytotb.Value

  'Visit each used cell in column B
  For Each R In Range("B1", Range("B" & Rows.Count).End(xlUp))
   'Search the file with the file mask from the cell (Note: can contain                 wildcards like *.xls)
    FName = Dir(SourcePath & R.Value & ".pdf")
    'Loop while files found
    Do While FName <> ""
      'Copy the file
      FileCopy SourcePath & FName, DestPath & FName
      'Search the next file
      FName = Dir()
    Loop
  Next

  MsgBox ("PDF's Copied")
End Sub

Ожидаемые результаты:

Когда команда Copy FilesПри нажатии этой кнопки файлы pdf с номерами деталей, перечисленными в столбце B, будут скопированы из первого расположения папки во второе расположение папки.

Если записи пустые, должно появиться сообщение с запросом выбора местоположения папки.

После перемещения файлов PDF должно появиться сообщение, сообщающее пользователю количество скопированных файлов.

Фактические результаты:

Вводится местоположение папкив необходимое текстовое поле, но файлы PDF не копируются в течение

PDF Copy

Ответы [ 2 ]

1 голос
/ 16 апреля 2019

попробуйте 

  dim counter as integer
  counter = 0

  'Visit each used cell in column B
  For Each R In Range("B1", Range("B" & Rows.Count).End(xlUp))
   'Search the file with the file mask from the cell (Note: can contain                 wildcards like *.xls)
    FName = Dir(SourcePath & R.Value & ".pdf")
    'Loop while files found
    Do While FName <> ""
      counter = counter + 1
      'Copy the file
      FileCopy SourcePath & FName, DestPath & FName
      'Search the next file
      FName = Dir()
    Loop
  Next

  MsgBox (counter & " PDF's Copied")

удачи

1 голос
/ 16 апреля 2019

Я только что понял свою ошибку

Мне нужно добавить обратную косую черту! 

  SourcePath = Me.copyfromtb.Value
  DestPath = Me.copytotb.Value

Изменено на 

  SourcePath = copyfromtb.Value & "\"
  DestPath = copytotb.Value & "\"

По-прежнему возникают проблемы с подсчетом числапереместил файлы и добавил это значение в окно сообщения в конце

...