用于访问特定文件的代码,但用户的计算机已设置

时间:2017-09-01 13:49:47

标签: windows excel-vba user-profile vba excel

这是我面临的问题。

通常,用户的计算机设置为在C:\Users\User name\Signature文件夹下记录的用户图形签名文件,作为在某些Excel进程中使用它的安全可靠的位置。但并非所有用户的签名文件都可以使用,因为以下代码并不总是正确报告文件夹路径。由于配置文件重建,我有一些用户在C:\Users\文件夹下设置了两个不同配置文件的机器设置 - 在查看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
'--------------------------------------------------------------------------

1 个答案:

答案 0 :(得分:1)

您可以使用Environ()

获取它
Function MyDocs() As String
    Dim strStart As String
    Dim strEnd As String

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

    MyDocs = strStart & strEnd
End Function