如何在VBA中引用当前的User \ Desktop位置

Question

您好，谢谢您的宝贵时间，在下面的功能代码中，我如何做到使其可以在任何用户计算机上运行，​​而不仅限于我的计算机上。

我知道我可能需要使用Environ（“ USERPROFILE”）东西，但是我不知道如何将其合并到下面的代码中。

Function Import_Data() As Boolean
   Dim x As Workbook
   Dim targetWorkbook As Workbook
   Dim xWs As Worksheet

   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

    Const F_PATH As String = "C:\Users\mohammad.reza\Desktop\MyFiles.xls"

    'if no file then exit and return false
    If Dir(F_PATH) = "" Then
    MsgBox "My Files is not found on your Desktop"
        Import_Data = False
        Exit Function
    End If

    'If the file exists than load the file and continue

    Import_Data = True

    ' This part delets all sheets except the summary tab
     For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Summary" Then
            xWs.Delete
        End If
    Next

' This part will get the raw data from the downloaded file on the desktop
     Set x = Workbooks.Open("C:\Users\mohammad.reza\Desktop\MyFiles.xls")
     Set targetWorkbook = Application.ActiveWorkbook

' This part will copy the sheet into this workbook
     With x.Sheets("MyFiles").UsedRange
     ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Range("A1").Resize( _
        .Rows.Count, .Columns.Count) = .Value
     End With
     x.Close

' This part will rename the sheet and move it to the end
ActiveSheet.Name = "RAW DATA"
ActiveSheet.Move After:=Worksheets(Worksheets.Count)

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Function

感谢您的回答，但是当我使用它时，它会出现以下错误：

Answer 1

尝试一下...

Function Import_Data() As Boolean
    Dim x As Workbook
    Dim targetWorkbook As Workbook
    Dim xWs As Worksheet
    Dim sPath As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    sPath = Environ("USERPROFILE") & "\Desktop\MyFiles.xls"

    'if no file then exit and return false
    If Dir(sPath) = "" Then
    MsgBox "My Files is not found on your Desktop"
        Import_Data = False
        Exit Function
    End If

    'If the file exists than load the file and continue

    Import_Data = True

    ' This part delets all sheets except the summary tab
     For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Summary" Then
            xWs.Delete
        End If
    Next

    ' This part will get the raw data from the downloaded file on the desktop
     Set x = Workbooks.Open(sPath)
     Set targetWorkbook = Application.ActiveWorkbook

    ' This part will copy the sheet into this workbook
     With x.Sheets("MyFiles").UsedRange
     ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Range("A1").Resize( _
        .Rows.Count, .Columns.Count) = .Value
     End With
     x.Close

    ' This part will rename the sheet and move it to the end
    ActiveSheet.Name = "RAW DATA"
    ActiveSheet.Move After:=Worksheets(Worksheets.Count)

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Function