如何设置文件路径



我要做的是复制/粘贴选定的报告。弹出选择菜单时如何添加默认路径?

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

我确实更改了您的代码,我很确定您的代码无法正常工作。您正确地从上载者工作簿复制,但随后关闭它并尝试粘贴到当前工作簿中。如果在复制时关闭工作簿,则不会有任何要粘贴的内容。

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

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

相关内容

  • 没有找到相关文章

最新更新