Question

我在Outlook中使用vba代码从电子邮件中获取一些文本并使用此文本在目录中创建一个Windows文件夹。

代码从电子邮件正文中拾取Company Name:之后的文本，然后应创建包含company name:

之后出现的任何文本的文件夹

所以如果我们有公司名称：Fred Burts

然后Fred Burts应该成为我们新的文件夹名称。

出于某种原因，错误似乎出现在我的字符串LResult336上，因为当我用文本替换它时，它可以正常工作。

有人可以解释为什么我收到错误的错误文件名吗？我使用LResult336作为字符串，其中包含我想要的文本作为我的文件夹名称。

Dim FSO As Object

Dim FolderPath As String
    Set FSO = CreateObject("scripting.filesystemobject")
 Dim b4 As String
 Dim strNewFolderName As String

 If TypeName(olkMsg) = "MailItem" Then
    b4 = olkMsg.Body

    Dim indexOfNameb As Integer
        indexOfNameb = InStr(UCase(b4), UCase("Company name: "))


    Dim indexOfNamec As Integer
       indexOfNamec = InStr(UCase(b4), UCase("Company number: "))

    Dim finalStringb As String

        finalStringb = Mid(b4, indexOfNameb, indexOfNamec - indexOfNameb)

        LResult336 = Replace(finalStringb, "Company Name: ", "")

    FolderPath = "\\uksh000-file06\purchasing\New_Supplier_Set_Ups_&_Audits\ATTACHMENTS\" & LResult336
    If FSO.FolderExists(FolderPath) = False Then
    Dim strDir As String
    strDir = "\\uksh000-file06\purchasing\New_Supplier_Set_Ups_&_Audits\ATTACHMENTS\" & LResult336
    If Dir(strDir, vbDirectory) = "" Then
    MkDir strDir
    Else
    MsgBox "Directory exists."
    End If

    Else

    End If

Answer 1

试试这个，您应该看到名称后面有换行符。

LResult336 = Replace(finalStringb, "Company Name: ", "")
Debug.Print "*" & LResult336 & "*"

这应该有效http://msdn.microsoft.com/en-us/library/dd492012%28v=office.12%29.aspx#Outlook2007ProgrammingCh17_ParsingTextFromAMessageBody

LResult336 = ParseTextLinePair(b4, "Company Name: ")
Debug.Print "*" & LResult336 & "*"

Function ParseTextLinePair _
  (strSource As String, strLabel As String)
    Dim intLocLabel As Integer
    Dim intLocCRLF As Integer
    Dim intLenLabel As Integer
    Dim strText As String
    intLocLabel = InStr(strSource, strLabel)
    intLenLabel = Len(strLabel)
        If intLocLabel > 0 Then
        intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
        If intLocCRLF > 0 Then
            intLocLabel = intLocLabel + intLenLabel
            strText = Mid(strSource, _
                            intLocLabel, _
                            intLocCRLF - intLocLabel)
        Else
            intLocLabel = _
              Mid(strSource, intLocLabel + intLenLabel)
        End If
    End If
    ParseTextLinePair = Trim(strText)
End Function

使用outlook vba创建文件夹

1 个答案: