読者です 読者をやめる 読者になる 読者になる

三流君 ken3のmemo置き場

メモ置き場、保管庫として利用。まとまっていませんがヨロシク



XXXXXさんへ Outlook VBA 連絡先 更新方法 と アドレスでITEMを検索する方法

Outlook VBA

下記のような質問をいただきました。



教えてください。
エクセル上でマクロを起動して、Outlookの連絡先をエクセルに落としデータをそのままエクセル上で編集し、
編集したものをまたOutlookの連絡先に書きに行きたいのです。
Outlook機能のエクスポートとインポートをすると手順がいっぱいあって時間が掛かるので、
マクロで、決まった項目だけ抜き出して編集し、それをまた戻すことをしたいです。

中略


実演にはInputboxから入力したものを連絡先に【追加】でしたが、既に存在する連絡先を特定セルのValueで書き換えたいです。
ただ、条件があって、エクセル上の編集の過程で、削除してしまった・新規を増やしてしまったという場合を
考慮して、IF条件で、メールアドレスでマッチングさせマッチしたら書きに行くことをしたいです。
(これは通常のvbaと一緒なので自分で記述できます。)
エクセル上のマクロならすんなり書けるのですが、Outlookの部分はどうコードを記述したらよいのか分かりません。。。

エクセルに落とすマクロまでは下記のようにできました。
落としたデータを編集して、いざOutlookに編集しにいく記述はどうすればいいでしょう。

同じようにoApp.CreateItem(2)を使うのでしょうか???

よろしく願します。

↓↓↓↓↓ ダウンロード用につくったSAMPLE ちなみにこれはちゃんと動きます。

  '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 
  '■ 
  '■ アドレス帳取得用 testマクロ SAMPLE    
  '■ 
  '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 
  ' 
  Sub sample() 
    
    '----------------------- 
    UserForm1.Show vbModal      '←マクロ実行中ユーザーフォーム表示 (実行中画面操作不可) 
    '----------------------- 
    
   
    End Sub 

Sub アドレス帳取得() 
    '----- 実行時 プレビュー非表示 
    Application.ScreenUpdating = False 
    
    
    
            '----- Outlook.Applicationの起動 
            Dim oApp As Object        'OutlookのApplication オブジェクトを入れる変数 
            Dim myNameSpace As Object '名前の領域を入れる変数 
            Dim myFolder As Object    'フォルダー指定する変数 
        
        
            Set oApp = CreateObject("Outlook.Application") 
            
            
            '.GetNamespace("MAPI") 
            Set myNameSpace = oApp.GetNameSpace("MAPI") 
            
            
            '作業フォルダーの指定(.GetDefaultFolder) と 表示(.Display) 
            Set myFolder = myNameSpace.GetDefaultFolder(10)      '連絡先 
            '----- 
            'Set objFolder = objSession.GetDefaultFolder(ObjectType) 
            'ObjectType パラメータには、必ず以下のいずれかの値を指定します。 
            
            '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 
            '■  ObjectType の設定  値  取得する既定のフォルダ 
            '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 
            '■   myNameSpace.GetDefaultFolder(3)       削除済みアイテム 
            '■   myNameSpace.GetDefaultFolder(4)       送信トレイ 
            '■   myNameSpace.GetDefaultFolder(5)       送信済みアイテム 
            '■   myNameSpace.GetDefaultFolder(6)       受信トレイ 
            '■   myNameSpace.GetDefaultFolder(9)       予定表 
            '■   myNameSpace.GetDefaultFolder(10)      連絡先 
            '■   myNameSpace.GetDefaultFolder(11)      履歴 
            '■   myNameSpace.GetDefaultFolder(12)      メモ 
            '■   myNameSpace.GetDefaultFolder(13)      仕事 
            '■   myNameSpace.GetDefaultFolder(16)      下書き 
            '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 
            
            '------------------------------------------------------------- 
            
            
                  
    
    'myFolder.Display  '連絡先を表示 
    
        Dim i As Long   'ループカウンターストック用変数 
        Dim r As Long   '列番号用ワーク変数 
        
        r = 2   '最初は2行目からにしたい(先頭にヘッダーがついているので) 
    
        For i = 1 To myFolder.Items.Count   '連絡先データの件数分繰り返す 
        
        '----- 
        Range("A" & r).Value = myFolder.Items(i).OfficeLocation        'A列に事業所を打ち出す      (A2から) 
        'Range("B" & r).Value = myFolder.Items(i).Department            'B列に部署を打ち出す        (B2から) 
        'Range("C" & r).Value = myFolder.Items(i).FullName              'C列に名前を打ち出す        (C2から) 
        'Range("D" & r).Value = myFolder.Items(i).Email1Address         'D列にアドレス打ち出す      (D2から) 
        'Range("E" & r).Value = myFolder.Items(i).JobTitle              'E列に役職を打ち出す        (E2から) 
        'Range("F" & r).Value = myFolder.Items(i).Account               'F列にアカウントを打ち出す  (F2から) 
        'Range("G" & r).Value = myFolder.Items(i).YomiLastName          'G列に姓(カナ)を打ち出す  (G2から) 
        'Range("H" & r).Value = myFolder.Items(i).YomiFirstName         'H列に名(メイ)を打ち出す  (H2から) 
        '----- 
        
        'プログレスバー(進捗状況)への反映 
        UserForm1.ProgressBar1.Value = i / myFolder.Items.Count * 100   '%で表示 (今の件数÷総件数×100) 
        
        '列番号に+1して次へ 
        r = r + 1 
    '-------------------------------------------------------------------------------- 
    ' 後続の処理が重くてユーザーフォームがうまく表示されないのを防ぐ 
    '  (フォームの枠だけ表示されて白抜きになって固まってしまう現象が起きるときに有効) 
    
    UserForm1.Repaint      '←『Me.Repaint』は、UserFormを強制表示させる効果があります。 
    '-------------------------------------------------------------------------------- 
        Next 
        
        'oApp.Quit 'outlook終了 
        Set objOutlook = Nothing 

End Sub


調べること

1.Outlook アイテムの更新方法

2.Outlook ITEMデータを探す方法

ア.おっさん(おいたん?は) 昔ながらで 頭からループ?

イ.小鳥遊びを読める若者は検索でしょ?

いつもの三流解説 ≒≠ 怪しい実演販売動画

アウトルックの連絡先データを更新する方法を探ってみました。

小鳥遊 が 読めない おっさん(おいたん?)らしく、
右往左往している酔っ払い動画ですが、
Outlook VBA 連絡先 更新方法 と アドレスでITEMを検索する方法 - YouTube
が、
怪しい実演販売の動画です(ぉぃぉぃ)

1.Outlook アイテムの更新方法
気分は灰色?な前置きは置いといて、
更新は、
.Display で 表示させ
.Items(i).プロパティ = "小鳥遊"
.Items(i).プロパティ = "zzzzzz"
で更新したい項目に値をセットして、
.Items(i).Save '保存
.Items(i).Close 2 '閉じる
そんな感じです。

レコードセットだと、
.Edit
フィールドにデータセット
.Update
みたいな感じなのかなぁ?
※.EDITみたいなヤツ(メソッド?)がありそうな気はするんですが、
 テストでたまたま.Displayで成功してしまったので、深く探っていません。
 (もし、よさそうなプロパティ、メソッドを見つけたら教えてください。私もみつけたら再度書き込みます。)

2.Outlook ITEMデータを探す方法

アイテムの検索は、
モロ DB処理に似ていて(フィルター処理に似ているかなぁ)
Set oITEM = oFolder.Items.Find("[項目] = '値'")
で探すことができそうです。

検索されたか?データ取得の確認は、
If Not oITEM Is Nothing Then 'オブジェクトの中身が入ってれば
でチェックすることができます。
※もしかしたら、If Not (oITEM Is Nothing) Then ?よくみたら、Not の Not?であるか見ているので変なIf文ですね。

複数ヒットする可能性がある時は、Items.FindNext あたりが使えそうです。

以上、無駄に長い三流解説ですが、
怪しい実演販売動画(やはりノーカットの脳内 自分語 垂れ流しは 無駄に迷っている時間が多いなぁ)
http://www.youtube.com/watch?v=-krNnjVKpIo
を見ながら、
自分色にアレンジしてみてください。

よろしくお願いします。
いつかはスカット空のような明るい青色のプログラムや解説をしたいと思いつつ...失礼します。
三流プログラマー Ken3



figma ブラック★ロックシューター 小鳥遊ヨミ 制服ver.

figma ブラック★ロックシューター 小鳥遊ヨミ 制服ver.