ソース PROG07.VBS




Set objFS = CreateObject("Scripting.FileSystemObject")
Folder = "C:\VBS_ProgramFiles\rename\recv"
Folder2 = "C:\VBS_ProgramFiles\rename\stor\"
Folder3 = "C:\VBS_ProgramFiles\rename\omsg\"
Folder4 = "C:\VBS_ProgramFiles\rename\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)
Neg_str = "\/:*?""<>|"
 'MsgBox(Neg_Str)

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


    Set objText = objFS.OpenTextFile(Folder & "\" & Folder_str & "\nse_internet_edi_pro_subject.txt")
       Select Case objText.AtEndOfStream
          Case True
            SubjCtr = 1
            ' MsgBox("True=fileEnd")
          Case Else
            ' MsgBox("Faulse=Suject is not Blank")
               SubjCtr = 0
               Subject = objText.Readline

                  'Msgbox("05 Subject" & vbCR & Subject)
                 For i = 1 To 9
                 SubjCtr = SubjCtr + InStr(Subject,Mid(Neg_str,i,1))
                 Next
       End Select
    objText.Close

  Select Case SubjCtr
   Case 0
    'MsgBox("07 Subject File名 適正" & vbCR & "通常実行します")

  '------------------------------------------------------
    For Each objFile in objFC.Files
       File_Name = objFile.Name
            'Msgbox(File_Name)
       Select Case Left(File_name,21)
           Case "nse_internet_edi_pro_"
               'MsgBox("10 対象外：無視します")
           Case Else
               'MsgBox("15 対象ファイルです")
               Set objFile2 = objFS.GetFile(Folder & "\" & Folder_str & "\" & File_Name)
               objExtent = objFS.GetExtensionName(Folder & "\" & Folder_str & "\" & File_Name)
               objOFBody = objFS.GetBaseName(Folder & "\" & Folder_str & "\" & File_Name)
                                    'MsgBox("20 objFile2" & vbCR & objFile2)

                           OldFileName = (objFile2.Name)
                                    'MsgBox("40 Subject" & vbCR & Subject)
                                    'MsgBox("50 objOFBody" & vbCR & objOFBody)
                                    'MsgBox("30 objExtent" & vbCR & objExtent)

                  Select Case objExtent
                      Case ""    'Msgbox("60 拡張子無し")
                                objNewFileName = Subject

                      Case Else  'Msgbox("70 拡張子あり、付加します")
                                objNewFileName = Subject & "." & objExtent
                  End Select
                                 'Msgbox("80 objNewFileName" & vbCR & objNewFileName)

                  Select Case Trim(objNewFileName)
                      Case Trim(OldFileName)
                                'MsgBox("90 同一名：リネームしません")
                      Case Else
                           objFile2.Name = objNewFileName
                                'MsgBox("100 リネームしました" & vbCR & objFile2.Name)
                  End Select
              Exit For
        End Select
     Next

           'MsgBox("110 貯蔵フォルダにコピーします" & vbCR & objFile2.Name)
           objFile2.Copy Folder2,True



    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
   Case Else
    ' MsgBox("115 Subject File名 不良" & vbCR & "ネグレクトします")
  End Select

       ' 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 終了します")