VBS for Email Attachment extraction under a specific user account

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.

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

Could you also show in the code where is should put the modification.
Thanks
Khanax

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.

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.

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

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.

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"

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.

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"

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.

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

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

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.