Использование файла, открытого в диалоге файлов с VBA - PullRequest
0 голосов
/ 31 августа 2018

Я пытаюсь скопировать информацию из вкладки в файле, открытом с помощью диалогового окна «Файл», и вставить ее в «ThisWorkbook»

Ниже моя попытка. Я продолжаю получать сообщение об ошибке

"объект не поддерживает это свойство или метод"

в строке жирным шрифтом.

Sub UpdateWeeklyJobPrep()
    Dim xlFileName As String
    Dim fd As Office.FileDialog
    Dim source As Workbook
    Dim currentwk As Integer
    Dim wksheet As String
    Dim target As ThisWorkbook
    Dim fso As Object
    Dim sourcename As String

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

     'Calc the current fiscal week
      currentwk = WorksheetFunction.WeekNum(Now, vbMonday)
      wksheet = "FW" & currentwk

    With fd
        .AllowMultiSelect = False
        .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1

        If .Show Then
           xlFileName = .SelectedItems(1)                   
        Else
           Exit Sub
        End If

    End With

    'Opens workbook
    Workbooks.Open (xlFileName), ReadOnly:=True

    'Get file name from path
    Set fso = CreateObject("Scripting.FileSystemObject")
    sourcename = fso.GetFileName(xlFileName)
    sourcename = Left(sourcename, InStrRev(sourcename, ".") - 1)

    'Copy/Paste Code Here
    **Workbooks(sourcename).Activate**
    Workbooks(sourcename).Worksheets(wksheet).Column("F").Copy
    target.Activate
    target.Sheets("Data Source").Column("C").PasteSpecial

    'close workbook with saving changes
    source.Close SaveChanges:=False
    Set source = Nothing


End Sub

1 Ответ

0 голосов
/ 31 августа 2018

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

Sub UpdateWeeklyJobPrep()
Dim xlFileName As String
Dim fd      As Office.FileDialog
Dim source  As Workbook
Dim currentwk As Integer
Dim wksheet As String
Dim fso     As Object
Dim sourcename As String

Dim mainWB  As Workbook

Set mainWB = ThisWorkbook

Set fd = Application.FileDialog(msoFileDialogFilePicker)

'Calc the current fiscal week
currentwk = WorksheetFunction.WeekNum(Now, vbMonday)
wksheet = "FW" & currentwk

With fd
    .AllowMultiSelect = False
    .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
    If .Show Then
        xlFileName = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With

'Opens workbook
Dim newWB   As Workbook
Set newWB = Workbooks.Open(xlFileName, ReadOnly:=True)

'Copy/Paste Code Here
mainWB.Sheets("Data Source").Column("C").Values = newWB.Worksheets(wksheet).Column("F").Values
newWB.Close savechanges:=False
Set newWB = Nothing
End Sub

Я также изменил бит Copy/PasteSpecial, предполагая, что вам просто необходимы значения. Обратите внимание: поскольку вы копируете весь столбец , это может занять некоторое время. Возможно, вы вместо этого захотите минимизировать этот диапазон только для используемых строк, но я оставлю это в качестве упражнения для читателя.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...