请版主解释一下这段代码

hbkeguojin

因为要对客户发邀请信，在网上下载了一段代码，有的看得懂，有的看不懂，望版主帮忙注释这段代码：
Sub mailto()
Application.ScreenUpdating = False
    Dim objOL As Object
    Dim itmNewMail As Object
    Dim i%, j%, k%, x%, y%
    Dim strbt() As String, strsj() As String, strsum$
   
    Set objOL = CreateObject("Outlook.Application")
    Sheets(1).Activate
    ActiveSheet.Range("a1").Select
    Set tk = ActiveCell.CurrentRegion
    k = tk.Columns.Count
    j = tk.Rows.Count - 1
    ReDim strbt(k)
    For i = 0 To k
    strbt(i) = Trim(Sheets(1).Range("a1").Offset(0, i).Value)
    Next i
    For x = 1 To j - 1
      If Trim(Sheets(3).Range("c" & x + 1)) <> "" Then
        Set itmNewMail = objOL.CreateItem(olMailItem)
        itmNewMail.Subject = Trim(Sheets(1).Range("a1").Offset(x, 1).Value) '& "" & Month(Date) & ""
        itmNewMail.To = Trim(Sheets(3).Range("c" & x + 1))
         
         For y = 0 To k
            ReDim strsj(y)
            strsj(y) = Sheets(1).Range("a1").Offset(x, y).Value
            strsum = strsum & strbt(y) & "      " & strsj(y) & vbCrLf
         Next y
         itmNewMail.body = strsum & vbNewLine & "     " '& Month(Date) & "" '& vbNewLine & Space(60) & "" ' & vbNewLine & Space(65) & Date
         itmNewMail.display
         Application.OnTime Now + TimeValue("00:00:05"), "hd"
         strsum = ""
       End If
    Next x
    itmNewMail.send
        
Set objOL = Nothing
Set itmNewMail = Nothing
Application.ScreenUpdating = True
End Sub
Sub hd()
     SendKeys "%{s}", True
End Sub
在线等，急用
把文件发上来，供参考。另我要对不同用户发内容相同的信件，可不可以群发形式发送。
附件：

hbkeguojin

本人急切希望得到大家的帮助

aaaaabbbbb

有点长，大概的意思是将SHEET1中的单元格的内容发送到SHEET3中对应的邮件地址里。

你想实现什么功能？

hbkeguojin

原帖由 aaaaabbbbb 于 2009-4-9 23:32 发表
有点长，大概的意思是将SHEET1中的单元格的内容发送到SHEET3中对应的邮件地址里。

你想实现什么功能？

是有点长。该代码是将SHEET1中的单元格的内容发送到SHEET3中对应的邮件地址里，但我现在想的是在SHEET1只将一个单元格的内容（比如C3的内容）发给SHEET3中所有的对应邮件地址里，而不是现在只能一对一发送。如C3只能发送SHEET3的第三行对应的邮件地址里。

aaaaabbbbb

试一下以下代码.


Sub mailto()
Application.ScreenUpdating = False
    Dim objOL As Object
    Dim itmNewMail As Object
    Dim i%, j%, k%, x%, y%
    Dim strbt() As String, strsj() As String, strsum$
   
    Set objOL = CreateObject("Outlook.Application")
    '------------------将邮件地址放到一起-----------
    Sheets("邮件地址").Activate
    rowofallmail = ActiveSheet.UsedRange.Rows.Count
    For i = 2 To rowofallmail
       allmail = Range("c" & i) & ";" & allmail
    Next i
   '------------------------------------------------
    Sheets(1).Activate
    ActiveSheet.Range("a1").Select
    Set tk = ActiveCell.CurrentRegion
    k = tk.Columns.Count
    j = tk.Rows.Count - 1
    ReDim strbt(k)
    For i = 0 To k
    strbt(i) = Trim(Sheets(1).Range("a1").Offset(0, i).Value)
    Next i
    For x = 1 To j - 1
     'If Trim(Sheets(3).Range("c" & x + 1)) <> "" Then
        Set itmNewMail = objOL.CreateItem(olMailItem)
        itmNewMail.Subject = Trim(Sheets(1).Range("a1").Offset(x, 1).Value) '& "" & Month(Date) & ""
     '   itmNewMail.to = Trim(Sheets(3).Range("c" & x + 1))
         '-------发送给所有人----------
         itmNewMail.to = allmail
         
         '-----------
         For y = 0 To k
            ReDim strsj(y)
            strsj(y) = Sheets(1).Range("a1").Offset(x, y).Value
            strsum = strsum & strbt(y) & "      " & strsj(y) & vbCrLf
         Next y
         itmNewMail.body = strsum & vbNewLine & "     " '& Month(Date) & "" '& vbNewLine & Space(60) & "" ' & vbNewLine & Space(65) & Date
         itmNewMail.display
         Application.OnTime Now + TimeValue("00:00:05"), "hd"
         strsum = ""
       'End If
    Next x
    itmNewMail.send
        
Set objOL = Nothing
Set itmNewMail = Nothing
Application.ScreenUpdating = True
End Sub
Sub hd()
     SendKeys "%{s}", True
End Sub

hbkeguojin

原帖由 aaaaabbbbb 于 2009-4-10 22:02 发表
试一下以下代码.


Sub mailto()
Application.ScreenUpdating = False
    Dim objOL As Object
    Dim itmNewMail As Object
    Dim i%, j%, k%, x%, y%
    Dim strbt() As String, strsj() As String, ...

谢谢！下来试试。

小安

试了一下上述附件，但只能“内容”一工作的A:Q列内容发送，如果要发送A:S列的内容，需改动哪里？谢谢！