客先から生産指示（品番・数量・金額など）の文字データとともに
別メールで生産図面が添付ファイルで送られてきます
少ない場合は手動で良いのですが
毎日20ファイル位あるとかなり面倒くさい（そうです）（他社での話です）

outlookVBAはあまりいじったこと無いのですがなんとかしてくれ
とのことで・・・

メール本文中の「品番：」のあとの文字列をファイル名として
添付ファイルを保存します
メールを複数選択して以下のコードを実行します
一応定形メール表題「ほげほげ」を確認します
outlookは使っていないのでもっといいやり方あったら教えて下さい

以下コード

Const HZNpath = “C:\Users\xxxx\Desktop\”’デスクトップに保存します

Sub 添付ファイル保存()
Dim objInbox As Object
Dim objFolder As Object
Dim strPath As String
Dim objItem As Object
Dim i As Long
Dim myPN As String
Dim pos As Integer

Set objInbox = GetNamespace(“MAPI”).GetDefaultFolder(olFolderInbox)
‘添付ファイルがあるメールのフォルダを指定します。2階層以上ある場合は「.Folders.Item(＜フォルダ名＞)」を追加してください。
Set objFolder = objInbox ‘.Folders.Item(“受信トレイ”) ‘.Folders.Item(“サブフォルダ”)

‘添付ファイルの保存先をパスで指定します。
strPath = HZNpath

For Each objItem In objFolder.Items
If TypeName(objItem) = “MailItem” And objItem.Subject Like “*ほげほげ*” Then ‘And objItem.UnRead
myPN = objItem.Body
pos = InStr(myPN, “品番：”)
myPN = Mid$(myPN, pos + 4)
myPN = Left$(myPN, InStr(myPN, vbCrLf) – 1) ’品番：の後ろの改行までを品番と見る
myPN = Trim$(myPN)
For i = 1 To objItem.Attachments.Count
‘添付ファイルに拡張子がある場合のみ処理します。
’今回の添付ファイルは図面で全て「.tif」です
If InStr(objItem.Attachments.Item(i), “.”) <> 0 Then
objItem.Attachments.Item(i).SaveAsFile strPath & myPN & “.tif”
End If
Next i
End If
Next objItem

Set objItem = Nothing
Set objInbox = Nothing
Set objFolder = Nothing

End Sub