OUTLOOKメールからのmsgファイル保存

Question

EXCELのVBAにて、outlookメールをシートに吐き出すマクロを作っています。

しかしながら、最終のSAVEASを実施すると、
エラーが出てとまってしまいます。

ディスクの要領は半分も空いておりますし、フォルダのパーミッションも特に問題ない状況です。何が悪いものでしょうか？

Sub msg_link()


Sheets("mail").Activate

 
Const olFolderInbox = 6


On Error Resume Next

Dim i As Integer
Dim FolderName As String
Dim MyDate As String
Dim MyFileName As String
Dim MySubject As String
Dim MySenderName As String
Dim StartTime As Date

StartTime = Now

FolderName = Sheets("menu").TextBox1.Text


Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
  strFolderName = objInbox.Parent
Set objMailbox = objNamespace.Folders(strFolderName)

y = 0
id = Sheets("menu").ComboBox1.ListIndex

If id <> -1 Then

y = 0

On Error Resume Next

For Each oMail In objMailbox.Folders(id + 1).Items
  sName = oMail.Subject
  sName = Replace(sName, "?", "？")
  sName = Left(sName, 50)

  dtDate = oMail.ReceivedTime
  sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "-hhnnss", _
    vbUseSystemDayOfWeek, vbUseSystem)
     
    sPath = FolderName & "\backup\"
**  Debug.Print sPath & sName
  oMail.SaveAs sPath & sName & ".txt", olTXT**
  
    Range("a2").Offset(y, 0) = Format(oMail.ReceivedTime, "yyyy/m/d")
    Range("a2").Offset(y, 1) = Format(oMail.ReceivedTime, "hh")
    Range("a2").Offset(y, 2) = Format(oMail.ReceivedTime, "nn")
    Range("a2").Offset(y, 3) = oMail.SenderName
    Range("a2").Offset(y, 4) = oMail.Subject
    bb = seiki(objItem.Body)
    Range("a2").Offset(y, 5) = Left(bb, 50)
    
    ActiveSheet.Hyperlinks.Add _
        Anchor:=Range("A2").Offset(y, 6), Address:=sPath & sName & ".txt", TextToDisplay:="msg"
    
    attno = oMail.Attachments.Count
        
        If attno > 0 Then
            For k = 1 To attno
                If Dir(sPath & sName, vbDirectory) = "" Then
                  MkDir sPath & sName
               End If
                
                oMail.Attachments(k).SaveAsFile (sPath & sName & "\" & oMail.Attachments(k).DisplayName)
                Next
                
                ActiveSheet.Hyperlinks.Add Anchor:=Range("A2").Offset(y, 7), Address:=sPath & sName & "\", TextToDisplay:="files"
        
        Else
            Range("A2").Offset(y, 7) = "なし"
        End If

end sub

Comments

[dodox86]

コードを提示されるときは、シンタックスハイライトを利用してください。https://teratail.com/help/question-tips また、お使いのWindows やExcel、Outlookのバージョンも記載するとより正確な回答をいただけると思います。

Answer 1

メール保存時のフォルダ名およびファイル名に、禁止文字が含まれていることが原因でした。

今回は「：」の半角コードでした。

ひとまず、禁止文字一覧をreplace することで、無事に保存までできるようになりました。

しかしながら、msgを保存しても、次にoutlookから閲覧できなくなってしまいました。

散々なやんだ結果、保存形式をMHLにして、ＩＥで表示させることにしました。

ＩＥでの表示についても、一点課題がありそれについては次の質問にすることにします。

いま、仕事で激務のため、これらの情報は時間ができたときに、quiita等であっぷしたいと思います。

Answer 2

※直接の回答ではありません。

bb = seiki(objItem.Body) とseki関数の内容が分からないのと、お使いのExcelシート("menu"など)の内容が不明なので当方で再現できず、確かなことは言えないのですが、

oMail.Attachments(k).SaveAsFile (sPath & sName & "\" & oMail.Attachments(k).DisplayName)

で実行するときのファイル名が、PATHの文字列として不正になっていたりしませんでしょうか。エラーメッセージの内容と合致しませんが、Outlookにおいてファイル保存に関わるエラーを全て、ご提示のエラー表示に集約している可能性はあります。

Dim fileName
fileName = sPath & sName & "\" & oMail.Attachments(k).DisplayName
Debug.Print fileName
oMail.Attachments(k).SaveAsFile(fileName)

などとして、ファイル名のPATHが正しく生成されているか確認してみてはいかがでしょうか。

また、On Error Resume Nextでエラーを握りつぶしていますので、このままだとエラーが起きていても分かりません。何かしらエラーが起きていて、ファイル名の生成に不都合が生じているかもしれません。

On Error GoTo Error1

... いろいろな処理

Error1:
    MsgBox "エラー番号:" & Err.Number & vbCrLf & _
           "エラーの種類:" & Err.Description, vbExclamation

などどして、マクロの実行時にエラーが起きていないか確認してみてください。