简体   繁体   中英

Code to access a specific file however the user's machine is set-up

This is the issue I am facing.

Normally the user's machine is set-up with a user graphic signature file recorded under the C:\\Users\\User name\\Signature folder as a safe and secure place for using it in some Excel processes. But not all users' signature files could be used as the folder path is not always correctly reported by the below code. I have some users with a machine set-up with two differents profiles under the C:\\Users\\ folder due to profile rebuilt - causing headache when looking at the location for the specific graphic file Excel is using. I attached sample of the code used to search for the correct folder.

So, could you provide me with information on what settings must be set, what changes in the code must be done, to ensure a reliable access to the graphic file however the user's profile is set-up on the machine?

------------------
Main Module
ChDrive "C"
strPictureFilePath = MyDocs()
strPictureFileName = "MySignature.jpg"
ActiveSheet.Shapes.AddPicture Filename:=(strPictureFilePath & strPictureFileName), linktofile:=msoFalse, _
    savewithdocument:=msoCTrue, Left:=162, Top:=445, Width:=170, Height:=35
------------------
Sub Module
Option Explicit
     ' Declare for call to mpr.dll.
   Declare Function WNetGetUser Lib "mpr.dll" _
      Alias "WNetGetUserA" (ByVal lpName As String, _
      ByVal lpUserName As String, lpnLength As Long) As Long
   Const NoError = 0       'The Function call was successful
   Function GetUserName()
      ' Buffer size for the return string.
      Const lpnLength As Integer = 255
      ' Get return buffer space.
      Dim status As Integer
      ' For getting user information.
      Dim lpName, lpUserName As String
      ' Assign the buffer size constant to lpUserName.
      lpUserName = Space$(lpnLength + 1)
      ' Get the log-on name of the person using product.
      status = WNetGetUser(lpName, lpUserName, lpnLength)
      ' See whether error occurred.
      If status = NoError Then
         ' This line removes the null character. Strings in C are null-
         ' terminated. Strings in Visual Basic are not null-terminated.
         ' The null character must be removed from the C strings to be used
         ' cleanly in Visual Basic.
         lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
      Else
         ' An error occurred.
         MsgBox "Unable to get the name."
         End
      End If
      GetUserName = lpUserName
   End Function
'--------------------------------------------------------------------------
Function MyDocs() As String
    Dim strStart As String
    Dim strEnd As String
    Dim strUser As String

    strUser = GetUserName()
    strStart = "C:\Users\"
    strEnd = "\Signature\"

    MyDocs = strStart & strUser & strEnd
End Function
'--------------------------------------------------------------------------

You can get it with Environ()

Function MyDocs() As String
    Dim strStart As String
    Dim strEnd As String

    strStart = Environ("USERPROFILE")
    strEnd = "\Signature\"

    MyDocs = strStart & strEnd
End Function

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM