Using Array for Attachments?

Status
Not open for further replies.
H

hlock

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
 
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)

-

"hlock" <hlock> wrote in message

news:36C98517-93F4-4441-9F79-5AFE27F2F2E4@microsoft.com...
> 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
>
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
J Add an Attachment Using an Array and Match first 17 Letters to Matching Template .oft to Send eMail Outlook VBA and Custom Forms 2
A Why not using DAG virtual IP/fqdn for CAS array in two nodes setup? Exchange Server Administration 2
H using VBA to edit subject line Outlook VBA and Custom Forms 0
e_a_g_l_e_p_i Need clarification on 2-Step Verification for Gmail using Outlook 2021 Using Outlook 10
e_a_g_l_e_p_i Outlook 2021 not letting me setup my Gmail using pop Using Outlook 1
Geldner Problem submitting SPAM using Outlook VBA Form Outlook VBA and Custom Forms 2
O How to find out the domain and server settings that my Outlook is using? Using Outlook 2
S Outlook 2019 Custom outlook Add-in using Visual Studio Outlook VBA and Custom Forms 0
D Outlook 2021 Using vba code to delete all my spamfolders not only the default one. Outlook VBA and Custom Forms 0
M using excel to sort outlook appointment items Outlook VBA and Custom Forms 4
R Advise on using multiple instances of network files based on customers Outlook VBA and Custom Forms 8
HarvMan Using Emojis in Outlook 365 Using Outlook 3
T Outlook 2019 Not Using Auto Compete After Deletion of 365 Using Outlook 1
M USING INITIALS AS RECIPIENTS Using Outlook 1
T Outlook 2019 Using Gmail aliases in Outlook Using Outlook 6
M Saving emails using Visual Basic - Selecting folder with msoFileDialogFolderPicker Outlook VBA and Custom Forms 6
Z Import Tasks from Access Using VBA including User Defined Fields Outlook VBA and Custom Forms 0
justicefriends How to set a flag to follow up using VBA - for addressee in TO field Outlook VBA and Custom Forms 11
M Extract "Date sent" from emails (saved to folder using drag and drop) Outlook VBA and Custom Forms 1
I Outlook for Mac 2019 using on desktop and laptop IMAP on both need help with folders Using Outlook 1
David McKay VBA to manually forward using odd options Outlook VBA and Custom Forms 1
H Stationery using between OL 2019 and OL 2010 Using Outlook 0
P Prevent Outlook 2016 from using DASL filter Using Outlook 4
O Calendar - Location: what happens when using my own way of entering locations Using Outlook 1
M Disable Contact Card Results when using "Search People" in Outlook Ribbon Using Outlook 7
K can't get custom form to update multiple contacts using VBA Outlook VBA and Custom Forms 3
S Outlook VBA How to adapt this code for using in a different Mail Inbox Outlook VBA and Custom Forms 0
pcunite Outlook 2019/O365 Build 13127.20408 errors when using MAPI calls Using Outlook 1
B Change Font and Font size using VBA Outlook VBA and Custom Forms 9
M Outlook 2013 reminder email by using Outlook vba Outlook VBA and Custom Forms 2
X Using Outlook 2013 and Outlook 365 Using Outlook 1
A Going to folder using shortcuts Using Outlook 3
A Outlook replies not using "delivered to" address in From Using Outlook 1
Terry Sullivan E-Mails Sent Using a Group Box Result in 70 Kickbacks Using Outlook 4
O Email not leaving Outbox when using Excel VBA to sync Outlook account Outlook VBA and Custom Forms 4
K Using Outlook 2016 to draw Using Outlook 1
O Outlook 365 - suddenly unable to send using Gmail POP3 Using Outlook 10
N Disable Auto Read Receipts sent after using Advanced Find Using Outlook 4
G Outlook 2016 sync contacts directly between phone and computer using outlook 2016 Using Outlook 0
L Moving emails with similar subject and find the timings between the emails using outlook VBA macro Outlook VBA and Custom Forms 1
O Save attachments using hotkey without changing attributes Outlook VBA and Custom Forms 1
A Edit subject - and change conversationTopic - using VBA and redemption Outlook VBA and Custom Forms 2
A Using or not using apostrophes in search terms has this changed? Using Outlook 0
O Office 365 using POP3 on both laptop and desktop Using Outlook 0
M Using field names to capture a data element Using Outlook 0
B Vba to monitor time to respond to emails using a shared mailbox Outlook VBA and Custom Forms 5
B Looking to get the Recipient email address (or even the "friendly name") from an email I am replying to using VBA Outlook VBA and Custom Forms 4
D Using a VBA Custom Form to Send Reoccurring Email Upon Task Completion Outlook VBA and Custom Forms 4
Z Adding dropdown list using custom form Outlook VBA and Custom Forms 7
O Using .OST and .PST mail thru different providers Using Outlook 5

Similar threads

Back
Top