Блог

Использование Excel 2013. Мой первый пост после многих лет поиска и адаптации.

Я пытаюсь сопоставить текущего пользователя приложения, то есть «Джона Смита», с его адресом электронной почты «jsmith@work.com «.

Используя две строки: 1 для пользователей (от 1 до 3), другой электронный адрес (от 1 до 3). Я хочу получить адрес электронной почты текущего пользователя для использования в отдельном подразделении, которое отслеживает текущего пользователя по электронной почте.

Я попробовал For Each i In user и установил eName на eaddress(i) . Это вернуло только последнего указанного пользователя / электронную почту.

 Private Sub (useremail)
Dim user (1 To 3), eaddress (1 To 3), fullName, eName As String

fullName = Application.UserName
user(1) = "John Smith"
user(2) = "Debbie Adams"
user(3) = "Karen Jones"

eaddress(1) = "jsmith@work.com"
eaddress(2) = "dadams@work.com"
eaddress(3) = "kjones@work.com"

For i = 1 To 3
    'For Each i In user
        fullName = user(i)
        eName = eaddress(i)
    'Exit For
    debug.print "User is " amp; fullname amp; "email to " amp; eName
Next i


  

Хотите получить eaddress / eName текущего пользователя (для использования в отдельном вложенном файле электронной почты).

Вы можете использовать Dictionary , чтобы упростить это

 Private Sub UsereMail()
    Dim dictInfo, fullName

    fullName = Application.UserName

    Set dictInfo = CreateObject("Scripting.Dictionary")
    dictInfo.Add "John Smith", "jsmith@work.com"
    dictInfo.Add "Debbie Adams", "dadams@work.com"
    dictInfo.Add "Karen Jones", "kjones@work.com"

    If dictInfo.Exists(fullName) Then
        Debug.Print "User is " amp; fullName amp; " email to " amp; dictInfo(fullName)
    End If
End Sub
  

Используя ваш оригинальный подход на основе массива:

 Sub tester()
    Debug.Print "John Smith", UserEmail("John Smith") '>> jsmith@work.com
    Debug.Print "John Brown", UserEmail("John Brown") '>> [blank]
End Sub


Private Function UserEmail(userName As String) As String

    Dim user(1 To 3), eaddress(1 To 3), m

    user(1) = "John Smith"
    user(2) = "Debbie Adams"
    user(3) = "Karen Jones"

    eaddress(1) = "jsmith@work.com"
    eaddress(2) = "dadams@work.com"
    eaddress(3) = "kjones@work.com"

    m = Application.Match(userName, user, 0)
    If Not IsError(m) Then UserEmail = eaddress(m)

End Function
  

Другой подход, основанный на словаре, при котором список пользователей не обязательно должен располагаться в том же порядке, что и адреса электронной почты.

 Option Explicit

Sub Test()
Dim user(1 To 3)            As String
Dim eaddress(1 To 3)        As String
Dim user_dic                As Scripting.Dictionary

user(1) = "John Smith"
user(2) = "Debbie Adams"
user(3) = "Karen Jones"

eaddress(1) = "jsmith@work.com"
eaddress(2) = "dadams@work.com"
eaddress(3) = "kjones@work.com"

Set user_dic = MatchUsersToEmail(eaddress, user)

Debug.Print eaddress(1), user_dic.Item(eaddress(1))
Debug.Print eaddress(2), user_dic.Item(eaddress(2))
Debug.Print eaddress(3), user_dic.Item(eaddress(3))

End Sub

Public Function MatchUsersToEmail(ByRef email_array() As String, ByRef user_array() As String) As Scripting.Dictionary
' Returns a scripting dictionary where the email address returns the user name
Dim my_users                As Scripting.Dictionary
Dim my_user                 As Variant
Dim my_email                As Variant
Dim my_name()               As String
Dim my_key                  As String
    Set my_users = New Scripting.Dictionary

    For Each my_email In email_array
        ' Add the email address as the key
        my_users.Add Key:=CStr(my_email), Item:=vbNullString

    Next

    For Each my_user In user_array
        my_name = Split(LCase$(my_user))
        my_key = Left$(my_name(0), 1) amp; my_name(1) amp; "@work.com"
        my_users.Item(my_key) = my_user

    Next

    Set MatchUsersToEmail = my_users

End Function