VBA - link to [any] the current user's desktop

[AV_Geek]

I'm trying to build a Mac that will link to the desktop of the current user, whoever that is.

Using these two macros:

Sub RunOnAllFilesInFolderWindows()

Dim wbOpen As Workbook

Dim MyDir As String

MyDir = "C:\Users\00000000\Desktop\Action" 'This is the path to your files



'Comment out the 3 lines below to debug'Application.ScreenUpdating = False'Application.Calculation = xlCalculationManual'On Error Resume Next

strExtension = Dir(MyDir & "\*.xlsx")





While strExtension <> vbNullString

Set wbOpen = Workbooks.Open(MyDir & "\" & strExtension)



With wbOpen

Call RemoveUnnecessary

Call RemoveXpoints

Call Rename_Sheet

ActiveWorkbook.SaveAs fileName:="C:\Users\00000000\Desktop\Action\" & ActiveSheet.Name & ".xlsx"



.Close SaveChanges:=True

End With



strExtension = Dir

Wend



Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

End Sub



Sub CombineFilesWindows()



Dim Path As String

Dim fileName As String

Dim Wkb As Workbook

Dim ws As Worksheet



Application.EnableEvents = False

Application.ScreenUpdating = False

Path = "C:\Users\00000000\Desktop\Action\" 'Change as needed

fileName = Dir(Path & "\*.xls", vbNormal)

Do Until fileName = ""

Set Wkb = Workbooks.Open(fileName:=Path & "\" & fileName)

For Each ws In Wkb.Worksheets

ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

Next ws

Wkb.Close False

fileName = Dir()

Loop

Application.EnableEvents = True

Application.ScreenUpdating = True



End Sub

If user 00000000 is logged in, this works. I need something for user 00000000,00000001, 00000002, 00000003, etc.

I tried the following, but none worked:

C:\Users\*\Desktop\Action
C:\Users\userprofile\Desktop\Action
C:\Users\*%userprofile%\Desktop\Action

 

[MARK858]

Userprofile includes the Drive and Folder, try for the 2nd macro (same syntax for the first macro)....

ActiveWorkbook.SaveAs Filename:=Environ("userprofile") & "\Desktop\Action\" & ActiveSheet.Name & ".xlsx"

or

Dim strFolderName As String
strFolderName = CreateObject("wscript.shell").specialfolders("Desktop") & "\Action\" & ActiveSheet.Name & ".xlsx"
ActiveWorkbook.SaveAs Filename:=strFolderName

 

[AV_Geek]

Userprofile includes the Drive and Folder, try for the 2nd macro (same syntax for the first macro)....

ActiveWorkbook.SaveAs Filename:=Environ("userprofile") & "\Desktop\Action\" & ActiveSheet.Name & ".xlsx"

or

Dim strFolderName As String
strFolderName = CreateObject("wscript.shell").specialfolders("Desktop") & "\Action\" & ActiveSheet.Name & ".xlsx"
ActiveWorkbook.SaveAs Filename:=strFolderName

I apologize, but I don't understand what I should do.

try for the 2nd macro (same syntax for the first macro)....

Are you saying I should use either of the above corrections in my second macro, but leave my first macro alone, with the user name in the path???

Also, if I need to use the second mod that you made, what does it replace?

 

[MARK858]

They both replace

ActiveWorkbook.SaveAs fileName:="C:\Users\00000000\Desktop\Action\" & ActiveSheet.Name & ".xlsx"

In the 2nd macro

You use

Environ("userprofile") & "\Desktop\Action\" & ActiveSheet.Name

anywhere you need the path to the file on the desktop
for instance

MyDir = "C:\Users\00000000\Desktop\Action"

becomes

MyDir = Environ("userprofile") & "\Desktop\Action\" & ActiveSheet.Name

With the specialfolders you put

Dim strFolderName As String
strFolderName = CreateObject("wscript.shell").specialfolders("Desktop") & "\Action\" & ActiveSheet.Name

Somewhere near the top of your code then use strFolderName as your file path wherever you need it i.e.

MyDir = "C:\Users\00000000\Desktop\Action"

becomes

MyDir = strFolderName

Please note that I have removed the .xlsx so it can be used generically in the code so when you need the extension you need to add it back in i.e,

ActiveWorkbook.SaveAs Filename:=strFolderName & ".xlsx"

 

[AV_Geek]

I think I got it. I just need to test it on another user. Thanks!!!!!!