Search code examples
excel

How to reference the current User\Desktop location in VBA

Hello and thank you for your time, in the function code below, how do I make it in a way that it will function on any users computer, not just mine.

I know I need to probably use the Environ("USERPROFILE") thing but I don't know how to incorporate it in the code below. 

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

Thank you brad for your answer, however when I use it, it gives the below error:

Error

Solution

  • Try this ...

    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