2

メールアドレスに応じてメールの添付ファイルをフォルダーに保存するVBAマクロを作成しようとしています。たとえば、joey@me.com から添付ファイルを受信して​​電子メールで送信する場合、その添付ファイルをディレクトリ \server\home\joey に保存するか、steve@me.com から受信する場合、添付ファイルを \server に保存する必要があります。 \ホーム\スティーブ .

そして最後に、保存したファイルの名前を返信メールで送りたいです。やりたいことをほぼ実行するコードをいくつか見つけましたが、それを変更するのに苦労しています。これはすべて Outlook 2010 で行われています。どんな助けでも大歓迎です

Const mypath = "\\server\Home\joe\"
Sub save_to_v()

    Dim objItem As Outlook.MailItem
    Dim strPrompt As String, strname As String
    Dim sreplace As String, mychar As Variant, strdate As String
    Set objItem = Outlook.ActiveExplorer.Selection.item(1)
    If objItem.Class = olMail Then

        If objItem.Subject <> vbNullString Then
            strname = objItem.Subject
        Else
            strname = "No_Subject"
        End If
        strdate = objItem.ReceivedTime

        sreplace = "_"

        For Each mychar In Array("/", "\", ":", "?", Chr(34), "<", ">", "|")

            strname = Replace(strname, mychar, sreplace)
            strdate = Replace(strdate, mychar, sreplace)
        Next mychar

        strPrompt = "Are you sure you want to save the item?"
        If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
            objItem.SaveAs mypath & strname & "--" & strdate & ".msg", olMSG
        Else
            MsgBox "You chose not to save."
        End If
    End If
End Sub
4

2 に答える 2

1

これはあなたがしようとしていることですか？(未テスト)

Option Explicit

Const mypath = "\\server\Home\"

Sub save_to_v()

    Dim objItem As Outlook.MailItem
    Dim strPrompt As String, strname As String, strSubj As String, strdate As String
    Dim SaveAsName As String, sreplace As String
    Dim mychar As Variant

    Set objItem = Outlook.ActiveExplorer.Selection.Item(1)

    If objItem.Class = olMail Then

        If objItem.Subject <> vbNullString Then
            strSubj = objItem.Subject
        Else
            strSubj = "No_Subject"
        End If

        strdate = objItem.ReceivedTime

        sreplace = "_"

        For Each mychar In Array("/", "\", ":", "?", Chr(34), "<", ">", "|")
            strSubj = Replace(strSubj, mychar, sreplace)
            strdate = Replace(strdate, mychar, sreplace)
        Next mychar

        strname = objItem.SenderEmailAddress

        strPrompt = "Are you sure you want to save the item?"

        If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
            Select Case strname
            Case "joey@me.com"
                SaveAsName = mypath & "joey\" & strSubj & "--" & strdate & ".msg"
            Case "steve@me.com"
                SaveAsName = mypath & "steve\" & strSubj & "--" & strdate & ".msg"
            End Select

            objItem.SaveAs SaveAsName, olMSG
        Else
            MsgBox "You chose not to save."
        End If
    End If
End Sub
于 2012-04-20T09:01:08.617 に答える
0

それは決してうまくいきません。Outlook 2010 は msg ファイルをネットワーク ドライブに保存しないため、ローカル ドライブのみが機能しています。M$ のドキュメントに記載されており、私がテストしたとおりです。固定パスとファイル名を使用した簡単なテスト。ローカル c:\ は機能します。UNC または L: のネットワーク ドライブが機能しません!!!!

于 2013-07-22T12:04:10.423 に答える