VB不熟悉FolderManager.FolderExists(Rst!Accessory) 这句报错,提示未定义,要去引用 哪个部件?
下面这段 代码为何不能正常使用我将网上的一段代码放到里面,却无法使用。
If FolderManager.FolderExists(Rst!Accessory) Then '判断文件夹是否存在 这句话报错了 提示未定义,要去引用 哪个部件? Set cFolder = FolderManager.GetFolder(("D:\1219\1"))
Set cFile = cFolder.Files '建立文件集合
For Each FileInfo In cFile
jmail.Message.AddAttachment "D:\1219\1\" & FileInfo.Name
Next
End If
jmail.ClearRecipients '清除原来的地址
jmail.我声明了,但没看代码要声明这个FolderManager之类的东西
网上原代码是
Private Sub SendMail()
Dim jmail As New SMTPMail
Dim Conn As New ADODB.Connection
Dim Rst As New ADODB.Recordset, Rst1 As New ADODB.Recordset
Dim strRec As String, strRecCC As String
'On Error GoTo Err:
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Password=dir941421;User ID=kiss;Data Source=" & App.Path & "\OAData\OAData.mdb;Persist Security Info=True;Jet OLEDB:System database=" & App.Path & "\OAData\Secured.mdw"
'检测是否有要发送的信件
Rst.CursorLocation = adUseClient
Rst.Open "Select * From ztblMailBox Where BoxNum = 2", Conn, adOpenDynamic, adLockOptimistic, adCmdText
Do While Not Rst.EOF '有要发送的信件
'先改变状态为已经发送失败,等发送成功后改变为成功
Conn.Execute "Update ztblMailBox Set BoxNum=3,SendState=False Where Id=" & Rst!id
'开始发送邮件Rst.CursorLocation = adUseClient
Rst1.Open "Select * From ztblMailConfig Where UserCode='" & Rst!UserCode & "'", Conn, adOpenDynamic, adLockOptimistic, adCmdText
If Rst1.EOF = False Then '有信箱存在
jmail.Sender = Rst1!MailName '取出发送者信箱名称
jmail.ServerAddress = Rst1!SmtpServer '服务器地址
jmail.ServerPort = "25"
jmail.SenderName = Rst1!Sender '取出发信人的姓名:汉字的也可以
jmail.Message.From = Rst1!MailName '来之何方
jmail.Message.FromName = Rst1!Sender '取出发信人的姓名:汉字的也可以
jmail.Message.Subject = Rst!Topic '标题
jmail.Message.Body = Rst!Content '内容
jmail.ClearAttachments '清除原来的附件
If FolderManager.FolderExists(Rst!Accessory) Then '判断文件夹是否存在 我照抄了,
Set cFolder = FolderManager.GetFolder(Rst!Accessory)
Set cFile = cFolder.Files '建立文件集合
For Each FileInfo In cFile
jmail.Message.AddAttachment Rst!Accessory & "\" & FileInfo.Name
Next
End If
jmail.ClearRecipients '清除原来的地址
If Not IsNull(Rst!SendTo) Then
strRecCC = Rst!SendTo
If InStr(1, strRecCC, ";", vbTextCompare) <> 0 Then
strRec = Left(strRecCC, InStr(1, strRecCC, ";", vbTextCompare) - 1)
strRecCC = Mid(strRecCC, InStr(1, strRecCC, ";", vbTextCompare) + 1)
If InStr(1, strRecCC, "@", vbTextCompare) <> 0 Then
strRecCC = Replace(strRecCC, ";", "", 1, -1, vbTextCompare)
End If
End If
End If
jmail.Message.AddRecipient strRec
If strRecCC <> "" Then jmail.Message.AddRecipientCC strRecCC
jmail.Message.MailServerUserName = Left$(Rst1!MailName, InStr(1, Rst1!MailName, "@") - 1) '服务器的用户名称
jmail.Message.MailServerPassWord = Rst1!MailPass '密码验证
jmail.ContentTransferEncoding = "base64"
jmail.Encoding = "base64"
jmail.Message.Charset = "gb2312"
jmail.Message.Silent = True
jmail.Message.ContentType = "multipart/html" '文本还是网页
jmail.Logging = False '是否记录日志
If jmail.Message.Send(Rst1!SmtpServer) Then
Conn.Execute "Update ztblMailBox Set SendState=True Where Id=" & Rst!id
End If
End If
Rst1.Close
Rst.MoveNext
DoEvents
Loop
Err:
Rst.Close
jmail.Close
Set jmail = Nothing '彻底释放Jmail
Unload Me
End Sub