Как сослаться на текущее местоположение пользователя \ рабочего стола в VBA - PullRequest
0 голосов
/ 20 марта 2019

Здравствуйте и спасибо за ваше время, в приведенном ниже коде функции, как мне сделать так, чтобы он работал на любом компьютере пользователя, а не только на моем.

Я знаю, что мне, вероятно, нужно использовать объект 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

Спасибо, Брэд, за ваш ответ, однако, когда я его использую, выдает следующую ошибку:

Error

1 Ответ

1 голос
/ 20 марта 2019

Попробуйте это ...

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...