![]() |
If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Search this Thread | Display Modes |
|
#1
|
|||
|
|||
![]()
MailItem.Attachments is a collection (object), not a string.
You will need a loop throug hteh attachments the same way yo udo that below. -- Dmitry Streblechenko (MVP) http://www.dimastr.com/ OutlookSpy - Outlook, CDO and MAPI Developer Tool - "hlock" wrote in message ... I am having to recreate lotus notes code into outlook code and am finding it very difficult since I don't know coding very well. It's taken me a long time just to get where I am using snippets from what I have found from others. I know that what I want to do is for each attachment in a single email, I want to save it off, "remember" the path and filename and create a description. Then I need to use the path and filename and the description later during the creation of an .ini file. However, I'm not doing it correctly. I thought I should be using the string split(), but I am getting an error msg. I have indicated the error msg below. Since our IT dept doesn't have a lot of time to work on this, I'm trying to do it myself (lol!) Any advice would be much appreciate. If you would like the lotus notes script to be posted to see what was originally intended, let me know as I am not completely done with this yet. I am posting the whole code as I know that it is fraught with errors. However, it's a work in progress. Option Explicit Public Sub initialize() Dim fso Dim fil Dim objapp As Outlook.Application Dim ns As Outlook.NameSpace Dim ext As String Dim tempfile As String Dim tempdir As String Dim path As String Dim del As String Dim app As String Dim objitem As Object Dim strsubject As String Dim filename As String Dim objAttachments As Outlook.attachments Dim i As Long Dim lngCount As Long Dim strfile As String Dim strsender As String Dim strrecipient As String Dim strCC As String Dim strBCC As String Dim intsent As Date Dim strbody As String Set fso = CreateObject("Scripting.FileSystemObject") Set ns = GetNamespace("MAPI") Set objapp = CreateObject("Outlook.application") Select Case TypeName(objapp.ActiveWindow) Case "Explorer" Set objitem = objapp.ActiveExplorer.Selection.item(1) Case "Inspector" Set objitem = objapp.ActiveInspector.CurrentItem Case Else ' End Select tempdir = ("c:\temp\outlookimport") CheckFolder strsubject = objitem.Subject strsender = objitem.SenderName strrecipient = objitem.To strCC = objitem.CC strBCC = objitem.BCC intsent = objitem.SentOn strbody = objitem.Body filename = StripIllegalChar(strsubject) If fso.GetExtensionName(filename) = "" Then filename = filename & ".rtf" End If ext = fso.GetExtensionName(filename) path = fso.BuildPath(tempdir, filename) objitem.SaveAs path, olRTF Dim attachments() As String Dim attachdescs() As String Set objAttachments = objitem.attachments attachments = Split(objAttachments, ",") 'getting error msg here invalid procedure call or argument attachdescs = Split(strsubject, ",") 'getting error msg here invalid procedure call or argument lngCount = objAttachments.Count If lngCount 0 Then For i = lngCount To 1 Step -1 ReDim Preserve attachments(UBound(attachments) + 1) ReDim Preserve attachdescs(UBound(attachdescs) + 1) strfile = objAttachments.item(i).filename strfile = Replace(strfile, " ", "_") strfile = tempdir & "\" & strfile objAttachments.item(i).SaveAsFile strfile Next i End If Dim towfile As String Dim fileNum As String towfile = tempdir & "\tower.ini" fileNum = FreeFile Open towfile For Output As fileNum Open towfile For Output As fileNum Print #fileNum, "[Group1]" Print #fileNum, "Desc=" & filename Print #fileNum, "MultiPage=Yes" Print #fileNum, "DeleteWhen=Always" Print #fileNum, "DefaultApp=email" Print #fileNum, "ShowDesc=Yes" Print #fileNum, "EmailImport=Yes" Print #fileNum, "MAIL_FROM=" & strsender Print #fileNum, "MAIL_TO=" & strrecipient ' Adding the indexing info here If strCC "" Then Print #fileNum, "MAIL_CC=" & strCC Else Print #fileNum, "MAIL_CC=NULL " End If If strBCC "" Then Print #fileNum, "MAIL_BCC=" & strBCC Else Print #fileNum, "MAIL_BCC=NULL" End If Print #fileNum, "MAIL_DATE=" & intsent If filename "" Then Print #fileNum, "MAIL_SUBJECT=" & filename Else Print #fileNum, "MAIL_SUBJECT=NULL" End If If lngCount = 0 Then Print #fileNum, "NumberOfFiles=1" Print #fileNum, "File1=" & filename Print #fileNum, "Desc1=" & strsubject Else Print #fileNum, "NumberOfFiles=" & lngCount + 1 Print #fileNum, "File1=" & filename Print #fileNum, "Desc1=" & strsubject Dim z As Integer For z = 1 To lngCount Print #fileNum, "File" & (z + 1) & "=" & attachments(z) 'File2=C:\TMP\c2.bmp Print #fileNum, "Desc" & (z + 1) & "=" & attachdescs(z) 'This is the message body Next z End If Print #fileNum, "[General]" Print #fileNum, "NumberofGroups=1" Close fileNum 'Call IDMImport(towfile) 'fso.DeleteFile path, True 'Set fso = Nothing End Sub Function StripIllegalChar(StrInput) Dim RegX As Object Set RegX = CreateObject("vbscript.regexp") RegX.Pattern = "[\" & Chr(34) & "\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\\\?\/\,]" RegX.IgnoreCase = True RegX.Global = True StripIllegalChar = RegX.Replace(StrInput, "") ExitFunction: Set RegX = Nothing End Function Sub CheckFolder() Dim fso Dim fol As String fol = ("c:\temp\outlookimport") Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FolderExists(fol) Then fso.CreateFolder (fol) End If End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
array index out of bounds | Cnewman65 | Outlook - General Queries | 1 | May 22nd 09 01:35 PM |
Read all folders into an array | Martin@att | Outlook and VBA | 2 | November 5th 08 04:07 PM |
iterating an array | Jade | Outlook and VBA | 1 | July 9th 08 08:11 PM |
Array Problems | Dan Allason | Outlook - Using Forms | 2 | February 21st 07 03:43 PM |
Array of outlook items....HELP!! | WhytheQ | Outlook and VBA | 5 | June 26th 06 01:52 PM |