Problem with CDONTS (Is there a size limit?) 1

[redsand]

I am having an issue with a vb app that uses CDONTS to send attachments.
The app first goes and gets the directory name, grabs the files in the directory using

objNewMail.AttachFile nochange, File1.List(ii),

I then open a access database to associate an email address to the folder name. Once that is complete I execute

objNewMail.Send "test@test.com", email, "Sales for " &
Company & " "
I have a label on the form that let's me know what is sending and refreshing.

Each folder has 3 excel files. Ranging from 10kb to 750kb
My problem is that I get an a Run time error '61' Disk Full error.

If I step through it(F8), I seem to be getting further before it errors.

Is there an item with CDONTS that I need to close?

I am setting this after each objNewMail.Send
Set objNewMail = Nothing
Set objNewMail = CreateObject("CDONTS.NewMail&quot

I am at a loss. If I take the attachments out of the folders and send the e-mails without attachments, it works great, Also works great with 1 excel file in each folder.

Anyhelp would be greatly appreciated.

 

[tnguyen03]

...shouldn't you already have the Set objNewMail = CreateObject("CDONTS.NewMail&quot before objNewMail.Send???
...after Set objNewMail = Nothing, you should loop back to the top and run this feature again for each file in the folder, no need to Set objNewMail = CreateObject("CDONTS.NewMail&quot again.

Have Fun!

 

[redsand]

I have 5 files in each directory, I use the directory name to link to an access db to get email address.
I want to be able to attach the multiple files to an email and send out. It seems like something is filling up and I either get a disk full error or this error.
Run time error '-2147024784(80070070) Method 'send' of object 'INewMail' filed.

Here is my code.

Private Sub Dirfind(ByVal sPattern As String, ByVal Currdir As String, sFound() As String)

Dim i As Integer
Dim sCurrPath As String
Dim sFile As String
Dim ii As Integer
Dim iFiles As Integer
Dim iLen As Integer
Dim nochange As String
Dim objNewMail As CDONTS.NewMail
Dim rs As Recordset
Dim CurrDir1 As String
Dim msg
Dim msg1
Dim dbTable As DAO.Database
Dim rsField As DAO.Recordset
Dim qdfSQL As DAO.QueryDef
Dim time As Timer
If Right$(Currdir, 1) <> &quot;\&quot; Then
Dir1.Path = Currdir & &quot;\&quot;
elist = Right$(Currdir, 4)
CurrDir1 = Mid(Currdir, 1, 29)
Else
Dir1.Path = Currdir

End If

For i = 0 To Dir1.ListCount
'Create Email Object fields************
Set objNewMail = CreateObject(&quot;CDONTS.NewMail&quot

If Dir1.List(i) <> &quot;&quot; Then
DoEvents
Call Dirfind(sPattern, Dir1.List(i), sFound)
Else
If Right$(Dir1.Path, 1) = &quot;\&quot; Then
sCurrPath = Left(Dir1.Path, Len(Dir1.Path) - 1)
Else
sCurrPath = Dir1.Path
End If
File1.Path = sCurrPath
File1.Pattern = sPattern
If File1.ListCount > 0 Then 'matching files found in the

For ii = 0 To File1.ListCount - 1
ReDim Preserve sFound(UBound(sFound) + 1)
sFound(UBound(sFound) - 1) = sCurrPath & &quot;\&quot; & File1.List(ii)
nochange = sCurrPath & &quot;\&quot; & File1.List(ii)
'Attached Multiple files based on ListCOunt
objNewMail.AttachFile nochange, File1.List(ii)
Next ii
Else
msg = MsgBox(&quot;we are done&quot
End If
iLen = Len(Dir1.Path)
Do While Mid(Dir1.Path, iLen, 1) <> &quot;\&quot;
iLen = iLen - 1
Loop
Dir1.Path = Mid(Dir1.Path, 1, iLen)
End If
Next i
If (ii) = File1.ListCount And (ii) <> 0 Then
'*************Get Email Address from Access*******************
'Call GetEmail(CurrDir1, elist, email, Company)
strAppDir = CurrDir1
strDBName = strAppDir & &quot;SalesEmail.mdb&quot;
Set dbTable = OpenDatabase(strDBName)
Set rsField = dbTable.OpenRecordset(&quot;Select Email,EmailName,Compname From tblEmail Where EmailName = '&quot; & elist & &quot;'&quot

With rsField
If Not rsField.EOF Then
Do Until rsField.EOF
DoEvents
email = rsField(&quot;Email&quot
Company = rsField(&quot;Compname&quot
rsField.MoveNext
Loop
Form1.Refresh
Form1.Label3 = &quot;Sending &quot; & Company & &quot; Emails&quot;
Form1.Refresh
'On Error Resume Next
objNewMail.Send &quot;test@test.com&quot;, email, &quot;Sales for &quot; & Company & &quot; &quot;




'Else
'msg = MsgBox(&quot;This is done&quot

End If
End With
rsField.Close
dbTable.Close
Set rsField = Nothing
Set dbTable = Nothing
Set objNewMail = Nothing
Set sarray = Nothing


Again, I know this probably is not the best way to do this.... Anyhelp would be greatly appreciated.

 

[tnguyen03]

sorry for this late response, i just got back from a vacation. anyway, i see what you tried to do. as i can recommand, don't use CDONTS for your VB app, 'cause it designed for the web on NT server. instead, try to use MAPI object. here's somecodes that you can try:

Dim objSession As Object
Dim objMsg As Object
Dim objRcp As Object
Dim FileName As String
Dim filepath As String
Dim ProfileName As String


Set objSession = CreateObject(&quot;MAPI.Session&quot
objSession.Logon ProfileName '(eg. &quot;John Smith&quot
Set objMsg = objSession.Outbox.Messages.Add

With objMsg
.Subject = &quot;Multiple Attachments&quot;
.Text = &quot;Testing...&quot;
'start a For Loop here to set attachments
.Attachments.Add FileName, , 1, filepath
'end loop here
.Update
End With

Set objRcp = objMsg.Recipients.Add
With objRcp
.Name = &quot;test@test.com&quot;
.Type = 1
.Resolve
End With

objMsg.Send
objSession.Logoff
Set objSession = Nothing

Have Fun!