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

我确实对您的代码做了一些更改，并且我很确定您的代码无法正常工作。您从上载者工作簿中正确复制，但随后将其关闭并尝试粘贴到当前工作簿中。如果您在复制时关闭工作簿，则不会粘贴任何内容。

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

Answer 2

经过测试，下面的代码对我有用。非常感谢@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

如何设置文件路径？

2 个答案: