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