空メール処理システム：補助資料



ソース PROG08.VBS

Set objFS = CreateObject("Scripting.FileSystemObject")
Folder = "C:\vacmail\recv"
Folder2 = "C:\vacmail\stor\"
Folder3 = "C:\vacmail\omsg\"
Folder4 = "C:\vacmail\send\"
TimeCtr = 0
Set objFolder = objFS.GetFolder(Folder)
'----------------------------------------------------------
Time_str = Year(Now) & Month(Now) & Day(Now) & "_" & Hour(Now) & Minute(Now) & Second(Now)
      'MsgBox("03 Time_str = " & Time_str)


For Each objFC in objFolder.SubFolders
    Folder_str = objFC.Name


    Set objText = objFS.OpenTextFile(Folder & "\" & Folder_str & "\nse_internet_edi_pro_header.txt")
    Do While objText.AtEndOfStream <> True
       From_str = objText.Readline
       'Msgbox("210 Current_str=" & vbCR & From_str)
       Select Case Left(From_str,6)
         Case "From: "
           'MsgBox("220あった From_str=" & vbCR & From_str)
         Exit Do
       End Select
    Loop
    objText.Close
    To_str = Right(From_str,Len(From_str)-6)
      ' Msgbox("230 To_str=" & vbCR & To_str)

    TimeCtr = TimeCtr + 1
    OutFileName = "EDI_PRO_MAIL_" & Time_str & "_" & TimeCtr & ".txt"
      'MsgBox(OutFileName)
    Set objTextR = objFS.OpenTextFile(Folder3 & "Original_Msg.txt")
    Set objTextW = objFS.CreateTextFile(Folder4 & OutFileName)
    Do While objTextR.AtEndOfStream <> True 
       myText = objTextR.Readline
       objTextW.WriteLine(myText)
         Select Case ""
            Case myText
              objTextW.WriteLine(To_str)
         End Select
    Loop
    objTextR.Close
    objTextW.Close

       ' MsgBox("120 削除します" & vbCR & objFile2)
       Set objFile2 = objFS.GetFolder(Folder & "\" & Folder_str)
       objFile2.Delete True
Next

  '-------------------------------------------------------
  'MsgBox("200 MailConnect 送信を起動します")

Dim WSHShell
Set WSHShell = WScript.CreateObject("WScript.Shell")
WSHShell.Run("""C:\Program Files\Internet_EDI_Pro\PROGRAM\EDI_Send_MailConnect.exe"" mcj0001/s,1,True")


  'MsgBox("210 終了します")