如何通过OutLook 用VBA引用已经打开的EXCEL表格中的单元格

Question

直接上代码

Public Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Public Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Function WinProcA(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long

End Function
KillTimer 0, idEvent
DoEvents
Sleep 100
Application.SendKeys "%s"
End Function

' 发送单个邮件的子程序
Sub SendMail(ByVal to_who As String, ByVal subject As String, ByVal body As String, ByVal attachement As String)
Dim objOL As Object
Dim itmNewMail As Object
'引用Microsoft Outlook 对象
Set objOL = CreateObject("Outlook.Application")
Set itmNewMail = objOL.CreateItem(olMailItem)
With itmNewMail
.subject = subject '主旨
.body = body '正文本文
.BCC = to_who '收件者
.Display '启动Outlook发送窗口
SetTimer 0, 0, 0, AddressOf WinProcA
End With
Set objOL = Nothing
Set itmNewMail = Nothing
End Sub

'批量发送邮件
Sub BatchSendMail()
Dim rowCount, endRowNo
endRowNo = Workbooks(1).sheets("sheet1").CELLS(1, 1).CurrentRegion.Rows.Count
'逐行发送邮件
For rowCount = 1 To endRowNo
SendMail Excel.CELLS(rowCount, 1), Excel.CELLS(rowCount, 2), Excel.CELLS(rowCount, 3), Excel.CELLS(rowCount, 4)
Next
End Sub

想写一个程序通过OUTlook生成很多个新邮件，然后调用excel的内容填进邮件中，问题在最后的Cells 报错。。。

Answer 1

亲爱的最好用一个 txt 文件作为桥梁 来传输 excel和outlook的通信。
因为excel有线程锁定，您这种思路是不会成功的。
If flagifhasatta2 = True Then
Open "D:\工作总结\20160429翻译工作接管\" & mi40 & "\log.txt" For Append As #41

Write #41, "非英语校验返回但是没有附件，具体看邮件", mi888, mysender, Now(), Mid(item.Body, 1, miend)
Call 校验接收奖金计算noEN

Close #41

On Error GoTo 134

Open "D:\工作总结\20160429翻译工作接管\" & mi40 & "\其他语言校验返回\log.txt" For Append As #43

Write #43, "非英语校验返回但是没有附件，具体看邮件", mi888, mysender, Now(), Mid(item.Body, 1, miend)

Close #43
mycnt = 0
Exit Sub
End If

Answer 2

建议换个方式
你可以在excelvba里面编程, 调用outlook发送邮件即可
以前做过,现在东西找不到了,资料直接baidu就可以了本回答被网友采纳