Attribute VB_Name = "Module1"
'■　マクロ５００連発＜第２段＞
'
'　OUTLOOKのカレントユーザー情報を取得する
'
'  Copyright(C) 2000 Sunago
'
'　　このマクロを実行するとEXCELからOUTLOOKのカレントユーザー情報を
'  取得します。このマクロはMicrosoft Outlook *.* Object Libraryを
'  参照設定しない状態で動作するように作成していますが、コード等を
'  手直しする際にはLibraryを参照設定するようにしてください。
'
'  ※OUTLOOKの起動状態を判定するにはWIN32APIのFindWindow関数を
'  　用いますが、OUTLOOK97,98のクラス名が確認できなかったので、
'    コメントとしています
'
Option Explicit

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long

Sub Macro1()
Dim myOlApp As Object
Dim myNamespace
Dim myItem
Dim myRecipient
Dim nVal

    'nVal = FindWindow("rctrl_renwnd32", "")
    'rctrl_renwnd32はOUTLOOK2000のクラス名です
    '※OUTLOOK97,98ではクラス名が異なる可能性があります。
    
    'Outlook.Applicationのインスタンスを作成する
    On Error GoTo ErrorHandler
    Set myOlApp = CreateObject("Outlook.Application." & VerNo)
    On Error GoTo 0
    If Not myOlApp Is Nothing Then
        'Outlookデータへのアクセスを許可された名前空間MAPIを取得する
        Set myNamespace = myOlApp.GetNamespace("MAPI")
        MsgBox "ユーザー名　" & myNamespace.CurrentUser.Name & vbCr & _
               "アドレス　　" & myNamespace.CurrentUser.Address, , _
               "Outlookのカレント情報"
        'If nVal = 0 Then myOlApp.Quit
        Set myItem = Nothing
        Set myNamespace = Nothing
        Set myOlApp = Nothing
    End If
    Exit Sub
ErrorHandler:
    MsgBox "Outlook" & VerNo & "の起動に失敗しました"
End Sub

Function VerNo() As String
Dim strver As String
    
    strver = Application.Version
    VerNo = Int(Left(strver, InStr(strver, ".")))
End Function