在CDO电子邮件的文本正文中打印数组

时间:2015-03-06 02:23:24

标签: excel vba excel-vba cdo.message

我已经成功加载了一个包含数据的数组myArray(30,1),并希望在CDO电子邮件的文本正文中打印数据。这是可以正常使用的代码部分(已经服务了几个月)在我尝试在文本正文中打印数组之前。您可以看到我只是传递变量FullnameAmt

 Set iMsg = CreateObject("CDO.Message")
                With iMsg
                    Set .Configuration = iConf


                    .To = "MC123@gmail.com"
                    .From = """ME Report Error"" <MC124@gmail.com>"
                    .Subject = "Current Period Monthly Report variance"
                    .TextBody = "Hello," & vbNewLine & vbNewLine & _
                                "Please review the variances to NAV in the following report:" & vbNewLine & vbNewLine & _
                                "Report Location:  " & FullName & vbNewLine & vbNewLine & _
                                "Variance amount:  " & Amt & vbNewLine
                    .Send
                End With
                Set iMsg = Nothing

现在当我尝试在文本体中循环遍历我的数组时,我收到一个错误:

 Set iMsg = CreateObject("CDO.Message")
                With iMsg
                    Set .Configuration = iConf


                    .To = "MC123@gmail.com"
                    .From = """ME Report Error"" <MC124@gmail.com>"
                    .Subject = "Current Period Monthly Report variance"
                    .TextBody = "Hello," & vbNewLine & vbNewLine & _
          ERROR  ------------ >  & For x = LBound(myArray, 1) To UBound(myArray, 1)
                                  For y = LBound(myArray, 2) To UBound(myArray, 2)
                                    ThisWorkbook.Sheets("Sheet1").Cells(x + 1, y + 1) = myArray(x, y)
                                Next y
                            Next x
                    .Send
                End With
                Set iMsg = Nothing

我知道循环内部的语法不正确。我用它将数组放入电子表格(工作正常)。但是我希望稍微修改一下就可以让我把它放到电子邮件文本体中,但是它根本不喜欢我在那里放置代码。我收到的错误是

"Compile Error: Expected: Expression"

错误发生在&行下方第一行的.TextBody上。我不相信这个目标是可能的。我可能需要在电子表格中打印数组并将其作为附件发送,但更愿意将其打印在文本正文中。

非常感谢!

3 个答案:

答案 0 :(得分:1)

放置在电子邮件编译主体之外:

For x = LBound(myArray, 1) To UBound(myArray, 1)
      For y = LBound(myArray, 2) To UBound(myArray, 2)
        ThisWorkbook.Sheets("Sheet1").Cells(x + 1, y + 1) = myArray(x, y)
    Next y
Next x

将范围复制到剪贴板:

ThisWorkbook.Sheets("Sheet1").Range(ThisWorkbook.Sheets("Sheet1").Cells(1+LBound(myArray, 1),1+LBound(myArray, 2)),ThisWorkbook.Sheets("Sheet1").Cells(1+UBound(myArray, 1),1+UBound(myArray, 2))).Copy

然后你可以从剪贴板上获取数据:

"Hello," & vbNewLine & vbNewLine & ClipBoard_GetData()

但首先,您需要将函数声明放在代码顶部的任何函数或子函数之外:

Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _ 
   As Long 
Declare Function CloseClipboard Lib "User32" () As Long 
Declare Function GetClipboardData Lib "User32" (ByVal wFormat As _ 
   Long) As Long 
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal _ 
   dwBytes As Long) As Long 
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _ 
   As Long 
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _ 
   As Long 
Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) _ 
   As Long 
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _ 
   ByVal lpString2 As Any) As Long 

Public Const GHND = &H42 
Public Const CF_TEXT = 1 
Public Const MAXSIZE = 4096

Function ClipBoard_GetData() As String
   Dim hClipMemory As Long 
   Dim lpClipMemory As Long 
   Dim MyString As String 
   Dim RetVal As Long 

   If OpenClipboard(0&) = 0 Then 
      MsgBox "Cannot open Clipboard. Another app. may have it open" 
      Exit Function 
   End If 

   ' Obtain the handle to the global memory 
   ' block that is referencing the text. 
   hClipMemory = GetClipboardData(CF_TEXT) 
   If IsNull(hClipMemory) Then 
      MsgBox "Could not allocate memory" 
      GoTo OutOfHere 
   End If 

   ' Lock Clipboard memory so we can reference 
   ' the actual data string. 
   lpClipMemory = GlobalLock(hClipMemory) 

   If Not IsNull(lpClipMemory) Then 
      MyString = Space$(MAXSIZE) 
      RetVal = lstrcpy(MyString, lpClipMemory) 
      RetVal = GlobalUnlock(hClipMemory) 

      ' Peel off the null terminating character. 
      MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1) 
   Else 
      MsgBox "Could not lock memory to copy string from." 
   End If 

OutOfHere: 

   RetVal = CloseClipboard() 
   ClipBoard_GetData = MyString

End Function

答案 1 :(得分:0)

要在带有vba的字符串中插入双引号(“),您需要使用4个双引号:

MyName = "Fred " & """" & "Flinstone" & """"

字符串值为[Fred“Flinstone”]

答案 2 :(得分:-1)

你连续有两个&符号。

... & _
& ...

物理线解析器删除了下划线,因此逻辑行解析器会看到

... & & ...
  

&安培;结合字符串

     

_在下一个物理线上继续一条逻辑线