如何选定文件夹下所有文件
自己在网上找了一段自动发邮件的代码,但是觉得不满意,如何能将指定文件夹下的所有.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" 删除,将窗体设为不可见。