Как установить путь к файлу?

Question

Я пытаюсь скопировать / вставить выбранный отчет.Как добавить путь по умолчанию, когда появляется меню выбора?

Sub PopulateUploaderFunds()
Dim uploadfile As Variant
Dim uploader As Workbook
Dim CurrentBook As Workbook

Set CurrentBook = ActiveWorkbook
MsgBox ("Please select uploader file to be reviewed")
uploadfile = Application.GetOpenFilename()
    If uploadfile = "False" Then
        Exit Sub
    End If

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Workbooks.Open uploadfile
Set uploader = ActiveWorkbook
With uploader
    Application.CutCopyMode = False
    ActiveSheet.UsedRange.Copy
    uploader.Close
End With

CurrentBook.Activate
Sheets("Sheet1").Range("A1").PasteSpecial

Application.ScreenUpdating = True

End Sub

Answer 1

Код ниже работал для меня после тестирования. Большое спасибо @Damian. Я объединил его код с моим, в результате я получил именно то, что хотел.

    Sub PopulateUploaderFunds()
Dim uploadfile As Variant
Dim uploader As Workbook
Dim CurrentBook As Workbook

Set CurrentBook = ActiveWorkbook
MsgBox ("Please select uploader file to be reviewed")
    uploadfile = Application.FileDialog(msoFileDialogFilePicker)
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "" 'here place your path
        .AllowMultiSelect = False
        .Filters.Add "Custom Excel Files", "*.csv, *.xlsx, *.xls, *.txt"
        If .Show <> -1 Then Exit Sub  ' if Cancel is pressed
        uploadfile = .SelectedItems(1)
    End With

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Workbooks.Open uploadfile
Set uploader = ActiveWorkbook
With uploader
    Application.CutCopyMode = False
    ActiveSheet.UsedRange.Copy
    uploader.Close
End With

CurrentBook.Activate
Sheets("Sheet1").Range("A1").PasteSpecial

Application.ScreenUpdating = True

End Sub

Answer 2

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

Option Explicit
Sub PopulateUploaderFunds()

    Dim uploadfile As String 'not variant
    Dim uploader As Workbook
    Dim CurrentBook As Workbook

    MsgBox ("Please select uploader file to be reviewed")
    uploadfile = Application.FileDialog(msoFileDialogFilePicker)
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "C:\" 'here you change the path
        .AllowMultiSelect = False
        .Filters.Add "CSV", "*.csv"
        If .Show <> -1 Then Exit Sub  ' if Cancel is pressed
        uploadfile = .SelectedItems(1)
    End With

    Set CurrentBook = ThisWorkbook 'ActiveWorkbook would throw errors, ThisWorkbooks refers to the workbook which contains the code
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set uploader = Workbooks.Open(uploadfile, ReadOnly:=True) 'you can directly set the uploader workbook like this
    With uploader
        .Sheets("MySheet").UsedRange.Copy CurrentBook.Sheets("Sheet1").Range("A1") 'change MySheet for the name of your working sheet
        Application.CutCopyMode = False
        .Close SaveChanges:=False
    End With

    Application.ScreenUpdating = True

End Sub