Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 286
  • Last Modified:

VBS for Email Attachment extraction under a specific user account

I have a that extracts an attachment from my email account and process the file and puts it in the database.

The scripts works fine when I am logged on to my machine and execute it and all information is put into the database from  the file.

Question
I have created a user account called X1.  I have an email account for this user and I want  the VBS file to  to (impersonate)  this account and when I run and or schedule the script it should go to the email inbox on the Exchange server into the user X1 account  and extract the attachments and process them to the database.

Is this very difficult to do as I am not a VB expert.

----------------------- Currently if I log on to a machine as x1 and launch the script it does what I want it to but when I tried scheduling this script with a NT scheduler it failed and did nothing.

Please help

Thanks
Khanax



Const olFolderInbox = 6, intForReading = 1, ForAppending = 8

Dim Efso, Appendfile
Set Efso = CreateObject("Scripting.FileSystemObject")
Set Appendfile = Efso.OpenTextFile("C:\ascodata\archives\MRS_Processed_File_LOG.txt",ForAppending, True)

Set objShell = CreateObject("WScript.Shell")
Set appOutl = Wscript.CreateObject("Outlook.Application")
Set ns = appOutl.GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set objFSO = CreateObject("Scripting.FileSystemObject")

intLengthOfFileName = 13
strAttachmentExtensions = "mrs;MRS"
arrAttachmentExtensions = Split(strAttachmentExtensions, ";")
strProcessedFiles = ""

If Inbox.Items.Count = 0 Then
      MsgBox "There are no messages in the Inbox.", vbInformation, "Nothing Found"
      WScript.Quit
End If

intTotal = Inbox.Items.Count

For intItem = intTotal To 1 Step -1
      For Each Atmt In Inbox.Items(intItem).Attachments
            For intCount = LBound(arrAttachmentExtensions) To UBound(arrAttachmentExtensions)
                  'MsgBox Atmt.Filename
                  If Len(Atmt.FileName) = intLengthOfFileName And Right(Atmt.FileName, 3) = arrAttachmentExtensions(intCount) Then
                        strFilePath = "C:\ascodata\" & Atmt.DisplayName
                                    If objFSO.FileExists(strFilePath) = False Then
                              Atmt.SaveAsFile strFilePath
                              If strProcessedFiles = "" Then
                                    strProcessedFiles = strFilePath
                              Else
                                    strProcessedFiles = strProcessedFiles & ";" & strFilePath
                              End If
                                    End If
                  End If
            Next
      Next 'Atmt
Next 'Item
'MsgBox strProcessedFiles
 arrProcessedFiles = Split(strProcessedFiles, ";")
 For intCount = LBound(arrProcessedFiles) To UBound(arrProcessedFiles)       'FILE LOOP...


'MsgBox arrProcessedFiles(intCount)
 readline = (arrProcessedFiles(intCount) & " File processed on " & date)
 Appendfile.Write readline & vbCrLf


 Set arrFileData = Nothing
      Set objInputFile = objFSO.OpenTextFile(arrProcessedFiles(intCount),intForReading, False)
      strFileContents = objInputFile.ReadAll
      objInputFile.Close
      Set objInputFile = Nothing
     
     
dim arrRows
arrRows = Split(strFileContents, vbCrLf)    'VBScript has vbCrLf, vbCr, vbLF, vbNewline
dim intRow
For intRow = LBound(arrRows) To UBound(arrRows)                                                            ' ROW LOOP...
      dim psvRow
      psvRow = arrRows(intRow)      
      arrFileData = Split(psvRow, "|")
      'arrFileData = Split(strFileContents, "|")

'MsgBox "There are " & UBound(arrFileData) + 1 & " fields in " & arrProcessedFiles(intCount) & ", split by the pipe character"

      Set conn = CreateObject("ADODB.Connection")
      conn.ConnectionTimeout = 180
      conn.CommandTimeout = 180
      Set rs = Createobject("ADODB.Recordset")
      conn.open "Provider=OraOLEDB.Oracle;User ID= ;Password= ;Data Source= ;"
      If LCase(Right(arrProcessedFiles(intCount), 3)) = "mrs" Then
         strSQL = "INSERT INTO MAXIMO.EDI_RECEIVING (SITEID, PACKINGSLIPNUM, PONUM, POLINENUM,ITEMNUM, QUANTITY, TRANSDATE, PARTNUM, POC, POSTATUS, POLINESTATUS, OSND, RESOLUTIONCODE) Values("
         For intField = LBound(arrFileData) To UBound(arrFileData)                              ' MRS FIELD LOOP...
            If Right(strSQL, 1) = "(" Then
                  strSQL = strSQL & "UPPER('" & arrFileData(intField) & "')"
            Else
                  strSQL = strSQL & "," & "UPPER('" & arrFileData(intField) & "')"
            End If
         Next                                                                                                            ' ... MRS FIELD LOOP
         strSQL = strSQL & ")"
        ElseIf LCase(Right(arrProcessedFiles(intCount), 3)) = "pck" Then
         strSQL = "INSERT INTO MAXIMO.EDI_PACKING (SITEID, PONUM, POLINENUM, ITEMNUM, QUANTITY, PACKINGCODE, SHIPMENTID, SHIPDATE,CARRIER, CARRIERMETHOD, NUMOFPACKAGES, GROSSWEIGHT, GROSSWEIGHTUOM, BILLOFLADING, EXPORTBOXID, FOB, DESTINATION) Values("
         For intField = LBound(arrFileData) To UBound(arrFileData)                              ' PCK FIELD LOOP...
            If Right(strSQL, 1) = "(" Then
                  strSQL = strSQL & "UPPER('" & arrFileData(intField) & "')"
            Else
                  strSQL = strSQL & "," & "UPPER('" & arrFileData(intField) & "')"
            End If
         Next                                                                                                            ' ... PCK FIELD LOOP
         strSQL = strSQL & ")"
      End If

 '     MsgBox strSQL
      Set rs = conn.execute(strSQL)

Next                                                                                                                        ' ... ROW LOOP



     Set rs = Nothing
      objFSO.CopyFile arrProcessedFiles(intCount), "C:\ascodata\archives\", True
      'objFSO.DeleteFile arrProcessedFiles(intCount), True
Next                                                                                                                  ' ... FILE LOOP
Set objFSO = Nothing
'MsgBox "Done"
0
Khanax
Asked:
Khanax
  • 8
  • 7
1 Solution
 
RobSampsonCommented:
Hi Khanax,

When you say you tried to schedule this, what command did you use to run the script?

I assume that you made the scheduled task run under a certain use account (X1), which is fine.  Did you use this as the command path:
wscript "C:\pathtoscript\script.vbs"

If so, you could test that a script can run under another user account, by using that approach, but in "script.vbs" just have this:
'=======
Set objNetwork = CreateObject("WScript.Network")
MsgBox objNetwork.UserName
'=======

If that still doesn't work, then you may to schedule the task using the /INTERACTIVE switch with the AT command line tool.
http://support.microsoft.com/kb/313565

Regards,

Rob.
0
 
KhanaxAuthor Commented:
Hi Rob,
I think you helped me with the initial development of this script.  I hope all is well,  I have gotten stuck on one thing and it goes like this.   I want to make this script to run under X1 and get the email attachment from the Excahnge Server from a especfic user account.   The way it is created I am not sure where it is accessing the email account.  Is it looking at the INBOX / .pst file on the machine that it is installed on or is it looking at the INBOX for the user on the Server.

Thanks
Khanax
0
 
KhanaxAuthor Commented:
Could you also show in the code where is should put the modification.
Thanks
Khanax
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
RobSampsonCommented:
Hi Khanax, yes I remember helping you develop this one.  This script will only retrieve files using the local profile (and the default inbox) for the logged on user.  So, for example, if the X1 user profile does not have an Outlook profile set up, it will not be able to open any inbox.

So, I would suggest logging into Windows as X1, then setting up the mail profile to the required inbox.

I will look into whether we can make it open a specific user's inbox and work through that....

Regards,

Rob.
0
 
RobSampsonCommented:
OK, it looks like you may be able to use something like this:

strUserName = "John Smith"
Set myRecipient = myNameSpace.CreateRecipient(strUserName)
myRecipient.Resolve
If myRecipient.Resolved Then
    Set Inbox = myNameSpace.GetSharedDefaultFolder(myRecipient, olFolderInbox)
End If

which would go in place of
Set Inbox = ns.GetDefaultFolder(olFolderInbox)

and see how you go.  Bear in mind that X1 would need user rights to view that other Inbox.

Regards,

Rob.
0
 
KhanaxAuthor Commented:
What do you mean by this
"Bear in mind that X1 would need user rights to view that other Inbox."

I am bit confused.  So the code that above will go to the exchange server and check for email on the exchange server or is it going to open outlook on the ame machine that is running from and access the inbox that way. Please explain.

Thanks
Khanax
0
 
RobSampsonCommented:
Sorry Khanax, I wasn't clear on that.

The script is going to open Outlook on the same macine that it is running from, and by using the extra bit of code I posted above, it will open the specified users Inbox to read emails from.

Also, in terms of the user rights, some organisation prevent normal users from accessing the Inbox of another normal user.  Administrators of Exchange should be able to open any user's Inbox.  So, if the X1 account is a normal user, then you may need to grant that user permissions to open the specified (other users) Inbox.

I hope that makes it clearer.

Regards,

Rob.
0
 
KhanaxAuthor Commented:
Script : 'C:\mycode.vsb'
Line: 11
Char: 1
Error: Object Required: 'mynamespace'
Code: 800A01A8
Source: Microsoft VBScript Run time Error

Code used posted below:
Const olFolderInbox = 6, intForReading = 1, ForAppending = 8

Dim Efso, Appendfile
Set Efso = CreateObject("Scripting.FileSystemObject")
Set Appendfile = Efso.OpenTextFile("C:\ascodata\archives\MRS_Processed_File_LOG.txt",ForAppending, True)

Set objShell = CreateObject("WScript.Shell")
Set appOutl = Wscript.CreateObject("Outlook.Application")
Set ns = appOutl.GetNamespace("MAPI")
strUserName = "ascodata"
Set myRecipient = myNameSpace.CreateRecipient(strUserName)
myRecipient.Resolve
If myRecipient.Resolved Then
    Set Inbox = myNameSpace.GetSharedDefaultFolder(myRecipient, olFolderInbox)
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")

intLengthOfFileName = 13
strAttachmentExtensions = "mrs;MRS"
arrAttachmentExtensions = Split(strAttachmentExtensions, ";")
strProcessedFiles = ""

If Inbox.Items.Count = 0 Then
      MsgBox "There are no messages in the Inbox.", vbInformation, "Nothing Found"
      WScript.Quit
End If

intTotal = Inbox.Items.Count

For intItem = intTotal To 1 Step -1
      For Each Atmt In Inbox.Items(intItem).Attachments
            For intCount = LBound(arrAttachmentExtensions) To UBound(arrAttachmentExtensions)
                  'MsgBox Atmt.Filename
                  If Len(Atmt.FileName) = intLengthOfFileName And Right(Atmt.FileName, 3) = arrAttachmentExtensions(intCount) Then
                        strFilePath = "C:\ascodata\" & Atmt.DisplayName
                                    If objFSO.FileExists(strFilePath) = False Then
                              Atmt.SaveAsFile strFilePath
                              If strProcessedFiles = "" Then
                                    strProcessedFiles = strFilePath
                              Else
                                    strProcessedFiles = strProcessedFiles & ";" & strFilePath
                              End If
                                    End If
                  End If
            Next
      Next 'Atmt
Next 'Item
'MsgBox strProcessedFiles
 arrProcessedFiles = Split(strProcessedFiles, ";")
 For intCount = LBound(arrProcessedFiles) To UBound(arrProcessedFiles)       'FILE LOOP...


'MsgBox arrProcessedFiles(intCount)
 readline = (arrProcessedFiles(intCount) & " File processed on " & date)
 Appendfile.Write readline & vbCrLf


 Set arrFileData = Nothing
      Set objInputFile = objFSO.OpenTextFile(arrProcessedFiles(intCount),intForReading, False)
      strFileContents = objInputFile.ReadAll
      objInputFile.Close
      Set objInputFile = Nothing
     
     
dim arrRows
arrRows = Split(strFileContents, vbCrLf)    'VBScript has vbCrLf, vbCr, vbLF, vbNewline
dim intRow
For intRow = LBound(arrRows) To UBound(arrRows)                                                            ' ROW LOOP...
      dim psvRow
      psvRow = arrRows(intRow)      
      arrFileData = Split(psvRow, "|")
      'arrFileData = Split(strFileContents, "|")

'MsgBox "There are " & UBound(arrFileData) + 1 & " fields in " & arrProcessedFiles(intCount) & ", split by the pipe character"

      Set conn = CreateObject("ADODB.Connection")
      conn.ConnectionTimeout = 180
      conn.CommandTimeout = 180
      Set rs = Createobject("ADODB.Recordset")
      conn.open "Provider=OraOLEDB.Oracle;User ID=;Password=;Data Source=;"
      If LCase(Right(arrProcessedFiles(intCount), 3)) = "mrs" Then
         strSQL = "INSERT INTO MAXIMO.EDI_RECEIVING (SITEID, PACKINGSLIPNUM, PONUM, POLINENUM,ITEMNUM, QUANTITY, TRANSDATE, PARTNUM, POC, POSTATUS, POLINESTATUS, OSND, RESOLUTIONCODE) Values("
         For intField = LBound(arrFileData) To UBound(arrFileData)                              ' MRS FIELD LOOP...
            If Right(strSQL, 1) = "(" Then
                  strSQL = strSQL & "UPPER('" & arrFileData(intField) & "')"
            Else
                  strSQL = strSQL & "," & "UPPER('" & arrFileData(intField) & "')"
            End If
         Next                                                                                                            ' ... MRS FIELD LOOP
         strSQL = strSQL & ")"
        ElseIf LCase(Right(arrProcessedFiles(intCount), 3)) = "pck" Then
         strSQL = "INSERT INTO MAXIMO.EDI_PACKING (SITEID, PONUM, POLINENUM, ITEMNUM, QUANTITY, PACKINGCODE, SHIPMENTID, SHIPDATE,CARRIER, CARRIERMETHOD, NUMOFPACKAGES, GROSSWEIGHT, GROSSWEIGHTUOM, BILLOFLADING, EXPORTBOXID, FOB, DESTINATION) Values("
         For intField = LBound(arrFileData) To UBound(arrFileData)                              ' PCK FIELD LOOP...
            If Right(strSQL, 1) = "(" Then
                  strSQL = strSQL & "UPPER('" & arrFileData(intField) & "')"
            Else
                  strSQL = strSQL & "," & "UPPER('" & arrFileData(intField) & "')"
            End If
         Next                                                                                                            ' ... PCK FIELD LOOP
         strSQL = strSQL & ")"
      End If

 '     MsgBox strSQL
      Set rs = conn.execute(strSQL)

Next                                                                                                                        ' ... ROW LOOP



     Set rs = Nothing
      objFSO.CopyFile arrProcessedFiles(intCount), "C:\ascodata\archives\", True
      'objFSO.DeleteFile arrProcessedFiles(intCount), True
Next                                                                                                                  ' ... FILE LOOP
Set objFSO = Nothing
'MsgBox "Done"
0
 
RobSampsonCommented:
Sorry, Khanax, on this this line:
Set myRecipient = myNameSpace.CreateRecipient(strUserName)

and also this line:
Set Inbox = myNameSpace.GetSharedDefaultFolder(myRecipient, olFolderInbox)

Please change the word "myNamesSpace" to "ns"

Regards,

Rob.
0
 
KhanaxAuthor Commented:
Hi Rob,
I got this when I tried ot run the script
Microsoft Office Outlook
Warning:
A program is trying to access e-mail address you have stored in Outlook. Do you want to all this?
If this is unexpected, it may ba virus and you should choose 'No"
Yes                    No                 Help <-- buttons
There is a check boxo n that Dialog box and it asks you if you want to allow, once clicked then it allows you to do what ever.  After I manually clicked this

Then a second error.

Windows Script Host
Script D:\test.vbs
Line 23
Char 1
Error Object required: "Inbox"
Code: 800A01A8
Source Microsoft VBScript runtime error


I have user account setup in the computer which I will use for these transaction processing.
On that computer I have User ASCODATA
I have also setup the Email account for it and I can send/receive emails to it.
ASCODATA is an admin to the box

now here is the Problem I logged on the machine where I have every thing set up.
and Ran the below Posted Script and I got 2 errors and nothing happened.

Please help


Const olFolderInbox = 6, intForReading = 1, ForAppending = 8

Dim Efso, Appendfile
Set Efso = CreateObject("Scripting.FileSystemObject")
Set Appendfile = Efso.OpenTextFile("C:\ascodata\archives\MRS_Processed_File_LOG.txt",ForAppending, True)

Set objShell = CreateObject("WScript.Shell")
Set appOutl = Wscript.CreateObject("Outlook.Application")
Set ns = appOutl.GetNamespace("MAPI")
strUserName = "akhan"
Set myRecipient = ns.CreateRecipient(strUserName)
myRecipient.Resolve
If myRecipient.Resolved Then
    Set Inbox = ns.GetSharedDefaultFolder(myRecipient, olFolderInbox)
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")

intLengthOfFileName = 13
strAttachmentExtensions = "mrs;MRS"
arrAttachmentExtensions = Split(strAttachmentExtensions, ";")
strProcessedFiles = ""

If Inbox.Items.Count = 0 Then
      MsgBox "There are no messages in the Inbox.", vbInformation, "Nothing Found"
      WScript.Quit
End If

intTotal = Inbox.Items.Count

For intItem = intTotal To 1 Step -1
      For Each Atmt In Inbox.Items(intItem).Attachments
            For intCount = LBound(arrAttachmentExtensions) To UBound(arrAttachmentExtensions)
                  'MsgBox Atmt.Filename
                  If Len(Atmt.FileName) = intLengthOfFileName And Right(Atmt.FileName, 3) = arrAttachmentExtensions(intCount) Then
                        strFilePath = "C:\ascodata\" & Atmt.DisplayName
                                    If objFSO.FileExists(strFilePath) = False Then
                              Atmt.SaveAsFile strFilePath
                              If strProcessedFiles = "" Then
                                    strProcessedFiles = strFilePath
                              Else
                                    strProcessedFiles = strProcessedFiles & ";" & strFilePath
                              End If
                                    End If
                  End If
            Next
      Next 'Atmt
Next 'Item
'MsgBox strProcessedFiles
 arrProcessedFiles = Split(strProcessedFiles, ";")
 For intCount = LBound(arrProcessedFiles) To UBound(arrProcessedFiles)       'FILE LOOP...


'MsgBox arrProcessedFiles(intCount)
 readline = (arrProcessedFiles(intCount) & " File processed on " & date)
 Appendfile.Write readline & vbCrLf


 Set arrFileData = Nothing
      Set objInputFile = objFSO.OpenTextFile(arrProcessedFiles(intCount),intForReading, False)
      strFileContents = objInputFile.ReadAll
      objInputFile.Close
      Set objInputFile = Nothing
     
     
dim arrRows
arrRows = Split(strFileContents, vbCrLf)    'VBScript has vbCrLf, vbCr, vbLF, vbNewline
dim intRow
For intRow = LBound(arrRows) To UBound(arrRows)                                                            ' ROW LOOP...
      dim psvRow
      psvRow = arrRows(intRow)      
      arrFileData = Split(psvRow, "|")
      'arrFileData = Split(strFileContents, "|")

'MsgBox "There are " & UBound(arrFileData) + 1 & " fields in " & arrProcessedFiles(intCount) & ", split by the pipe character"

      Set conn = CreateObject("ADODB.Connection")
      conn.ConnectionTimeout = 180
      conn.CommandTimeout = 180
      Set rs = Createobject("ADODB.Recordset")
      conn.open "Provider=OraOLEDB.Oracle;User ID=;Password=;Data Source=;"
      If LCase(Right(arrProcessedFiles(intCount), 3)) = "mrs" Then
         strSQL = "INSERT INTO MAXIMO.EDI_RECEIVING (SITEID, PACKINGSLIPNUM, PONUM, POLINENUM,ITEMNUM, QUANTITY, TRANSDATE, PARTNUM, POC, POSTATUS, POLINESTATUS, OSND, RESOLUTIONCODE) Values("
         For intField = LBound(arrFileData) To UBound(arrFileData)                              ' MRS FIELD LOOP...
            If Right(strSQL, 1) = "(" Then
                  strSQL = strSQL & "UPPER('" & arrFileData(intField) & "')"
            Else
                  strSQL = strSQL & "," & "UPPER('" & arrFileData(intField) & "')"
            End If
         Next                                                                                                            ' ... MRS FIELD LOOP
         strSQL = strSQL & ")"
        ElseIf LCase(Right(arrProcessedFiles(intCount), 3)) = "pck" Then
         strSQL = "INSERT INTO MAXIMO.EDI_PACKING (SITEID, PONUM, POLINENUM, ITEMNUM, QUANTITY, PACKINGCODE, SHIPMENTID, SHIPDATE,CARRIER, CARRIERMETHOD, NUMOFPACKAGES, GROSSWEIGHT, GROSSWEIGHTUOM, BILLOFLADING, EXPORTBOXID, FOB, DESTINATION) Values("
         For intField = LBound(arrFileData) To UBound(arrFileData)                              ' PCK FIELD LOOP...
            If Right(strSQL, 1) = "(" Then
                  strSQL = strSQL & "UPPER('" & arrFileData(intField) & "')"
            Else
                  strSQL = strSQL & "," & "UPPER('" & arrFileData(intField) & "')"
            End If
         Next                                                                                                            ' ... PCK FIELD LOOP
         strSQL = strSQL & ")"
      End If

 '     MsgBox strSQL
      Set rs = conn.execute(strSQL)

Next                                                                                                                        ' ... ROW LOOP



     Set rs = Nothing
      objFSO.CopyFile arrProcessedFiles(intCount), "C:\ascodata\archives\", True
      'objFSO.DeleteFile arrProcessedFiles(intCount), True
Next                                                                                                                  ' ... FILE LOOP
Set objFSO = Nothing
'MsgBox "Done"
0
 
RobSampsonCommented:
Hi, I think we're going to have to change tracks on this one.....the Outlook.Application doesn't seem capable of doing this very well.  Let's try using CDO, although I can't test this because I don't have an Exchange server......
I do beleive there will be some security restrictions on another user's Inbox that you will need to change....please have a look at how you grant the user you run with, access to the other user's Inbox.

Try this code....again, untested.....you may with to place a wscript.quit somewhere after
MsgBox strProcessedFiles
just for testing, so you don't actually do the other stuff.  The main goal at the moment is to just open the other Inbox and check the attachments.

'================
'Source: http://mcpmag.com/newsletter/article.asp?EditorialsID=181
' There is also notes in the above link regarding the security rights
' on another user's mailbox.
Dim oSession 'As MAPI.Session
Dim oInbox 'As Object
Dim oMessages 'As MAPI.Messages
Dim oMessage 'As MAPI.Message
Const olFolderInbox = 6

Const intForReading = 1
Const ForAppending = 8

Dim Efso, Appendfile
Set Efso = CreateObject("Scripting.FileSystemObject")
Set Appendfile = Efso.OpenTextFile("C:\ascodata\archives\MRS_Processed_File_LOG.txt",ForAppending, True)

strPassword = Null
strServer = "servername"
strAccount = "Administrator"
Set oSession = CreateObject("MAPI.Session")
oSession.Logon "", strPassword, False, True, 0, False, strServer & Chr(10) & strAccount
'oSession.Logon , , False, True, , True, strServer & Chr(10) & strAccount
WScript.Echo "Logged on OK to the " & oSession.CurrentUser.Name & " account."

Set oInbox = oSession.Inbox
Set oMessages = oInbox.Messages
intTotal = oMessages.Count
WScript.Echo "There are " & intTotal & " messages in the Inbox of " & oSession.CurrentUser.Name

Set objFSO = CreateObject("Scripting.FileSystemObject")

intLengthOfFileName = 13
strAttachmentExtensions = "mrs;MRS"
arrAttachmentExtensions = Split(strAttachmentExtensions, ";")
strProcessedFiles = ""

If intTotal = 0 Then
      MsgBox "There are no messages in the Inbox.", vbInformation, "Nothing Found"
      WScript.Quit
End If

Set oMessage = oMessages.GetFirst
While Not oMessage Is Nothing ' loop through all messages
      For Each Atmt In oMessage.Attachments
            For intCount = LBound(arrAttachmentExtensions) To UBound(arrAttachmentExtensions)
                  'MsgBox Atmt.Filename
                  If Len(Atmt.FileName) = intLengthOfFileName And Right(Atmt.FileName, 3) = arrAttachmentExtensions(intCount) Then
                        strFilePath = "C:\ascodata\" & Atmt.DisplayName
                        If objFSO.FileExists(strFilePath) = False Then
                              Atmt.SaveAsFile strFilePath
                              If strProcessedFiles = "" Then
                                    strProcessedFiles = strFilePath
                              Else
                                    strProcessedFiles = strProcessedFiles & ";" & strFilePath
                              End If
                        End If
                  End If
            Next
      Next 'Atmt
    Set oMessage = oMessages.GetNext
Wend

MsgBox strProcessedFiles


arrProcessedFiles = Split(strProcessedFiles, ";")
 For intCount = LBound(arrProcessedFiles) To UBound(arrProcessedFiles)       'FILE LOOP...


'MsgBox arrProcessedFiles(intCount)
 readline = (arrProcessedFiles(intCount) & " File processed on " & date)
 Appendfile.Write readline & VbCrLf

 Set arrFileData = Nothing
      Set objInputFile = objFSO.OpenTextFile(arrProcessedFiles(intCount),intForReading, False)
      strFileContents = objInputFile.ReadAll
      objInputFile.Close
      Set objInputFile = Nothing
     
     
dim arrRows
arrRows = Split(strFileContents, vbCrLf)    'VBScript has vbCrLf, vbCr, vbLF, vbNewline
dim intRow
For intRow = LBound(arrRows) To UBound(arrRows)                                                            ' ROW LOOP...
      dim psvRow
      psvRow = arrRows(intRow)      
      arrFileData = Split(psvRow, "|")
      'arrFileData = Split(strFileContents, "|")

'MsgBox "There are " & UBound(arrFileData) + 1 & " fields in " & arrProcessedFiles(intCount) & ", split by the pipe character"

      Set conn = CreateObject("ADODB.Connection")
      conn.ConnectionTimeout = 180
      conn.CommandTimeout = 180
      Set rs = Createobject("ADODB.Recordset")
      conn.open "Provider=OraOLEDB.Oracle;User ID=;Password=;Data Source=;"
      If LCase(Right(arrProcessedFiles(intCount), 3)) = "mrs" Then
         strSQL = "INSERT INTO MAXIMO.EDI_RECEIVING (SITEID, PACKINGSLIPNUM, PONUM, POLINENUM,ITEMNUM, QUANTITY, TRANSDATE, PARTNUM, POC, POSTATUS, POLINESTATUS, OSND, RESOLUTIONCODE) Values("
         For intField = LBound(arrFileData) To UBound(arrFileData)                              ' MRS FIELD LOOP...
            If Right(strSQL, 1) = "(" Then
                  strSQL = strSQL & "UPPER('" & arrFileData(intField) & "')"
            Else
                  strSQL = strSQL & "," & "UPPER('" & arrFileData(intField) & "')"
            End If
         Next                                                                                                            ' ... MRS FIELD LOOP
         strSQL = strSQL & ")"
        ElseIf LCase(Right(arrProcessedFiles(intCount), 3)) = "pck" Then
         strSQL = "INSERT INTO MAXIMO.EDI_PACKING (SITEID, PONUM, POLINENUM, ITEMNUM, QUANTITY, PACKINGCODE, SHIPMENTID, SHIPDATE,CARRIER, CARRIERMETHOD, NUMOFPACKAGES, GROSSWEIGHT, GROSSWEIGHTUOM, BILLOFLADING, EXPORTBOXID, FOB, DESTINATION) Values("
         For intField = LBound(arrFileData) To UBound(arrFileData)                              ' PCK FIELD LOOP...
            If Right(strSQL, 1) = "(" Then
                  strSQL = strSQL & "UPPER('" & arrFileData(intField) & "')"
            Else
                  strSQL = strSQL & "," & "UPPER('" & arrFileData(intField) & "')"
            End If
         Next                                                                                                            ' ... PCK FIELD LOOP
         strSQL = strSQL & ")"
      End If

 '     MsgBox strSQL
      Set rs = conn.execute(strSQL)

Next                                                                                                                        ' ... ROW Loop



     Set rs = Nothing
      objFSO.CopyFile arrProcessedFiles(intCount), "C:\ascodata\archives\", True
      'objFSO.DeleteFile arrProcessedFiles(intCount), True
Next                                                                                                                  ' ... FILE LOOP
Set objFSO = Nothing
'MsgBox "Done"

Set oMessage = Nothing
Set oMessages = Nothing
Set oInbox = Nothing
oSession.Logoff
Set oSession = Nothing
MsgBox "Finished"
'===================

Regards,

Rob.
0
 
KhanaxAuthor Commented:
Hi Rob,
What do I have to do if I want to run this script under the same user that will be receiving the email.  for instance I am logged in as X1 and I want to access my own inbox on the server.  What do I need to modify in this script.  Thanks for all your help.

Thanks
Asher
0
 
RobSampsonCommented:
Not much really.
These are three parameters that you will need to set correctly:
strPassword = Null
strServer = "servername"
strAccount = "Administrator"

The strPassword can remain Null I think, to connect as the current user.  strServername is the name of your Exchange server, and strAccount should be the full Exchange user name of the mail box to connect to.

See how you go.

Regards,

Rob.
0
 
KhanaxAuthor Commented:
every thing seems to be working, one more favor I have a problem with the data feed it is coming with blank lines at the end of the feed I want to delete the blank line at the bottom of the feed could you please provide the code so when the file is extracted all the blank line at the bottom of the feed are truncated.

Thanks
AMK
0
 
RobSampsonCommented:
Hi, which file are you referring to that has blank lines?  One of the input files, or the MRS_Processed_File_LOG.txt file?

Regards,

Rob.
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 8
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now