Outlook vba를 사용하여 폴더 만들기

Question

Outlook에서 vba 코드를 사용하여 이메일에서 텍스트를 가져 와서이 텍스트를 사용하여 디렉토리에 Windows 폴더를 만듭니다.

코드는 이메일 본문에서 Company Name: 후 텍스트를 픽업 한 후 텍스트가 우리 회사 이름이 있다면 그래서 company name:

후 나타나는 어떤으로 폴더를 생성해야합니다 : 프레드 Burts를

그리고 프레드 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