Question

我有以下VBA，一旦有时间电子邮件中的描述字段就停止了。我已经研究过，似乎有255个字符的限制。我如何根据变量输入获得无限数量的字符。

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub GenerateVolumeQuoteEMail()
    Dim Email As String, Subj As String
    Dim Msg As String, URL As String
    Dim r As Integer, x As Double
    For r = 4 To 4 'data in rows 2-4
'       Get the email address
'       Email = Cells(r, 6)

'       Message subject
        Subj = "Volume Rate Request"

'       Compose the message
        Msg = ""
        Msg = Msg & "UTS Order ID: " & Cells(r, 12) & vbCrLf & vbCrLf
        Msg = Msg & "Shipping Adress: " & Cells(r + 1, 12) & vbCrLf & vbCrLf
        Msg = Msg & "Consignee Adress: " & Cells(r + 2, 12) & vbCrLf & vbCrLf
        Msg = Msg & "Description: " & Cells(r + 3, 12) & vbCrLf & vbCrLf
        Msg = Msg & "Hazmat (Yes or No): " & Cells(r + 4, 12) & vbCrLf & vbCrLf
        Msg = Msg & "Skid Count: " & Cells(r + 4, 12) & vbCrLf & vbCrLf
        Msg = Msg & "Weight (in LBS): " & Cells(r + 6, 12) & vbCrLf & vbCrLf
        Msg = Msg & "Class: " & Cells(r + 7, 12) & vbCrLf & vbCrLf
        Msg = Msg & "Dimensions: " & Cells(r + 8, 12) & vbCrLf & vbCrLf
        Msg = Msg & "Stackable: " & Cells(r + 9, 12) & vbCrLf & vbCrLf
        Msg = Msg & "Special Requirements: " & Cells(r + 10, 12) & vbCrLf & vbCrLf


'       Replace spaces with %20 (hex)
        Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
        Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

'       Replace carriage returns with %0D%0A (hex)
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
'       Create the URL
        URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

'       Execute the URL (start the email client)
        ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

'       Wait two seconds before sending keystrokes
'       Application.Wait (Now + TimeValue("0:00:02"))

'       Application.SendKeys "%s"
    Next r
End Sub

请在我还在学习的时候提供帮助。

Answer 1

如果@scraaappy是正确的，而您的问题仅仅是由于工作表函数Substitute的限制，那么您可以通过替换相应的行来轻松避免这些问题

    Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
    Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

    Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

使用replace代替：

    Subj = Replace(Subj, " ", "%20")
    Msg = Replace(Msg, " ", "%20")

    Msg = Replace(Msg, vbCrLf, "%0D%0A")

绕过在Outlook中创建电子邮件的255个字符数

1 个答案: