Path to USERPROFILE & DESKTOP

[upan275]

Hi All,

I need help....

I am using vba code to copy workbook from folders of user's desktop....Due to the use of same macro by differant user,i am using ENVIRON argument.

when i have more than one xls files in folder on user desktop,as per the code below,it shows message box..."There are more than one xls Files in UNASSIGNED FILES Folder." Hence folder is being accessed by code & I can say that Peth is complete & not broken.

when i have one xls file in folder...i am getting strange message. i cannot understand why it still shows message box as "SAP EXTRACTED EXCEL FILE IN UNASSIGNED FOLDER IS MISSING..!"" eventhough Only one xls file is clearly present..!!!

Same code is working well for 3 users since last 12 months,but just not working for new user & i cannot find it WHY???

Any guess??

'IF MORE THAN ONE FILE IN FOLDER THEN KILL ALL FILES
    Dim f1 As String, i As Long
    f1 = Dir(Environ("USERPROFILE") & "\Desktop\" & "MANIFEST CHECK\UNASSIGNED FILES\" & ("*.xls"))
    Do While f1 <> ""
    i = i + 1
    f1 = Dir
    Loop
    If i > 1 Then
    MsgBox "There are more than one xls Files in UNASSIGNED FILES Folder." & vbNewLine & "Press OK to Delete All Files & Process Unassiged file again "
    On Error Resume Next
    Kill Environ("USERPROFILE") & "\Desktop\" & "MANIFEST CHECK\UNASSIGNED FILES\" & ("*.xls")
    On Error GoTo 0
    Application.StatusBar = "PROCESS HAS BEEN TERMINATED.MULTIPLE UNASSIGNED FILES FOUND..."
    Exit Sub
    End If
'IF NO FILES FOUND
    Dim sFile As String
    ChDir Environ("USERPROFILE") & "\Desktop\" & "MANIFEST CHECK\UNASSIGNED FILES"
    sFile = Dir("*.xls")
    If Len(sFile) = 0 Then
    MsgBox " SAP EXTRACTED EXCEL FILE IN UNASSIGNED FOLDER IS MISSING..!"
       Application.StatusBar = "PROCESS HAS BEEN TERMINATED..."
    Exit Sub
    End If
'IF ONE FILE THEN GO AHEAD
    Name sFile As "unassigned.xls"
    Application.StatusBar = "PLEASE WAIT....WHILE COPYING  DATA FROM UNASSIGNED FILE...."
    Application.DisplayAlerts = False
    Workbooks.Open Filename:= _
    Environ("USERPROFILE") & "\Desktop\" & "MANIFEST CHECK\UNASSIGNED FILES\unassigned.xls"
    Workbooks.Open Filename:=Environ("USERPROFILE") & "\Desktop\" & "MANIFEST CHECK\aum.xls"
    Workbooks("unassigned.xls").Worksheets(1).Range("A:S").Copy Workbooks("aum.xls").Worksheets("UNASSIGNED").Range("B1")
    Application.StatusBar = "PLEASE WAIT....WHILE COPYING  DATA FROM SHIPMENT FILE...."

 

[jimrward]

Instead of using ENVIRON to get the location of the users desktop try the following code I found years ago, add your folder in accordingly

'****
' Declare what we need to get the Desktop location
'****

Dim oWSS As Object
Const szlocation As String = "Desktop"
Dim szDesktopPath As String
    
'****
' get the desktop location
'****

Set oWSS = CreateObject("WScript.Shell")
szDesktopPath = oWSS.SpecialFolders(szlocation)