Outlookのパブリックフォルダの投稿から一括で添付ファイルを取り出すExcelVBA2

スポンサーリンク

Office2013へのアップグレードでExcelVBAのコードが使用できなくなる

前回Outlookのパブリックフォルダに投稿されたファイルから添付ファイルを一括で取り出すで紹介したExcelVBAは、Office2007を使用していたのですが、Office2013へアップしたところ動かなくなってしまいました。

今回ExcelVBAが動かなくなった原因となる箇所を特定し、変更を加えたサンプルコードを作成したのでご紹介します。

Outlookのパブリックフォルダに投稿されたファイルから一括で添付ファイルを取り出すExcelVBAのコード

変更を加え、作成したサンプルコードは以下のようになります。
変更点は①と②の2か所です。

Sub パブリックフォルダの投稿からダウンロードする2()
Dim oApp As New Outlook.Application’変更点①
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim WSH As Variant
Set WSH = CreateObject(“Wscript.Shell”)
Dim DesktopPath As String
DesktopPath = WSH.SpecialFolders(“Desktop”)
Dim myNameSpace
Dim oFolder
Dim cITEM
Dim n As Integer, j As Integer ’ループのカウンター
Dim strFileName As String
Dim attm As Integer
If FSO.FolderExists(DesktopPath & “b”) = False Then ’デスクトップにbというフォルダが存在しなければ
FSO.CreateFolder DesktopPath & “b” ’デスクトップにbというフォルダを作成する
End If
Set myNameSpace = oApp.GetNamespace(“MAPI”)
Set oFolder = myNameSpace.GetDefaultFolder(18)’変更点②
Set oFolder2 = oFolder.Folders(“共有”)
’さらに下層のフォルダから投稿をダウンロードする場合は.Folders(“「フォルダ名」”)を付け加える
oFolder2.Display
For n = 1 To oFolder2.Items.Count
Set cITEM = oFolder2.Items(n)
attm = oFolder2.Items(n).Attachments.Count
Cells(n + 1, 1) = oFolder2.Items(n).Subject ’A列に件名を記載する
Cells(n + 1, 2) = oFolder2.Items(n).ReceivedTime ’B列に投稿時間を記載する
Cells(n + 1, 3) = oFolder2.Items(n).Body ’C列に本文を記載する
For j = 1 To attm
oFolder2.Items(n).Attachments(j).SaveAsFile (DesktopPath & “b” & Format(n, “000”) & “_” & Format(j, “00”) & “_” & oFolder2.Items(n).Attachments(j).DisplayName)
Cells(n + 1, 3 + j) = oFolder2.Items(n).Attachments(j).DisplayName
’添付ファイルのファイル名の先頭に何番目の投稿ファイルの何番目の添付ファイルかを記載してデスクトップの「b」というフォルダにダウンロードする
Next j
Next
Set cITEM = Nothing
Set oFolder = Nothing
Set oFolder2 = Nothing
Set FSO = Nothing
End Sub

スポンサーリンク

ExcelVBAサンプルコードの変更点

以下にサンプルコードの変更点を記します。

変更点①

Dim oApp
Set oApp = CreateObject(“Outlook.Application”)

Dim oApp As New Outlook.Application

こちらは環境によっても変更が必要かどうか異なるのですが、どうやら下のVBAコードの方が、エラーが起こりにくいようです。

具体的な違いはよく分かりませんでしたが、私の使用する環境では上のVBAコードを実行すると「ActiveXコンポーネントはオブジェクトを作成できません。」と表示され、VBAにエラーが起こりました。

変更点②

Set oFolder = myNameSpace.Session.Folders(“パブリック フォルダ”).Folders(“すべてのパブリック フォルダ”).Folders(“共有”)

Set oFolder = myNameSpace.GetDefaultFolder(18)
Set oFolder2 = oFolder.Folders(“共有”)

Office2013より「パブリックフォルダ」が「パブリックフォルダー – ××@××」という風に変更になっています。それぞれのメールアドレスを入っていることと、「フォルダ」「フォルダー」の違いにより、これまでのExcelVBAコードが使用できなくなりました。

どの環境でもパブリックフォルダを参照できるように「GetDefaultFolder(18)」を使用してパブリックフォルダを指定しています。

またさらに下層の投稿を取得するために「oFolder2」を指定し、「oFolder2」のフォルダを参照するように設定しています。

コメント