ユーザーのマシンがセットアップされていても特定のファイルにアクセスするコード

Question

これは私が直面している問題です。

通常、ユーザのマシンは、Excelの一部のプロセスで使用するための安全で安全な場所として、C:\Users\User name\Signatureフォルダに記録されたユーザグラフィックシグネチャファイルで設定されています。しかし、以下のコードでは、フォルダパスが正しく報告されていないため、すべてのユーザーの署名ファイルを使用することはできません。プロファイルが再構築されたため、C:\Users\フォルダの下に2つの異なるプロファイルを持つマシンを設定しているユーザーがいて、Excelが使用している特定のグラフィックファイルの場所を見て頭痛を引き起こします。正しいフォルダを検索するためのコードのサンプルを添付しました。

グラフィックスファイルへの信頼性の高いアクセスを保証するために、設定をどのように設定する必要があるか、コードの変更を行う必要があるかについての情報を私に提供できますか？

------------------ 
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 
'-------------------------------------------------------------------------- 

Answer 1

あなたはそれが正常に動作しますEnviron()

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

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

    MyDocs = strStart & strEnd 
End Function