VBA Outlook 본문 검색

Question

Outlook에서 선택한 메일을 찾아서 복사하려면 VBA가 필요합니다. 그 라인에는

메일 박스가 포함되어 있습니다 : ???????????????

그 라인에있는 문자의 수는 다소 또한 코드에 의해 열린 새 메일의 제목에 가야 라인을 복사 한이

Mailbox Details 
============================================================================== 
Mailbox:   /xxxxxx/xxxxxxxxxx/xxxxxxxxx 
Message Name:  xxxxxxxxxxxxxxxxxxxxxxxxx 
Message Id:  xxxxxxxxxxxxxxx 
============================================================================== 

처럼

이

메일이 보이는 다릅니다. 이것은 제가 지금 당장 가지고있는 것입니다. 제가 누락 된 부분은 그 주제에 특정 라인을 복사하는 방법입니다.

Sub SterlingForward() 

Set objItem = ForwardB() 
Set objItem = ForwardA() 

End Sub 


Function ForwardA() As Object 
Dim oAccount As Outlook.Account 
Dim initialSubj, finalSubj As String 
Dim oMail As Outlook.MailItem 
Set oMail = Application.ActiveExplorer.Selection(1).Reply 
oMail.SentOnBehalfOfName = "lol@.herp.com" 
oMail.To = "lol@.herp.com" 
oMail.Display 



Set myitem = Application.ActiveInspector.CurrentItem 
initialSubj = myitem.Subject 
initialBod = myitem.Body 

finalSubj = ?????????????????????? 


finalBody = "Hello Team," + vbCrLf + "resend was successful" + vbCrLf & CStr(initialBod) 
myitem.Subject = finalSubj 
myitem.Body = finalBody 


End Function 

Function ForwardB() As Object 
Dim objMail As Outlook.MailItem 
Dim initialSubj, initialBod, finalSubj, finalBody As String 
Set objItem = GetCurrentItem() 
Set objMail = objItem.Forward 
objMail.To = "lol@derp.com" 
objMail.Display 
Set objItem = Nothing 
Set objMail = Nothing 


Set myitem = Application.ActiveInspector.CurrentItem 
initialSubj = myitem.Subject 
initialBod = myitem.Body 

finalSubj = ???????????????????????????? 

finalBody = "Hello Team," + vbCrLf + "resend was successful" + vbCrLf & CStr(initialBod) 
myitem.Subject = finalSubj 
myitem.Body = finalBody 


End Function 

Function GetCurrentItem() As Object 
Dim objApp As Outlook.Application 
Set objApp = Application 
On Error Resume Next 
Select Case TypeName(objApp.ActiveWindow) 
Case "Explorer" 
Set GetCurrentItem = _ 
objApp.ActiveExplorer.Selection.Item(1) 
Case "Inspector" 
Set GetCurrentItem = _ 
objApp.ActiveInspector.CurrentItem 
Case Else 
End Select 
End Function 

Answer 1

는 ("사서함"initialBod) http://www.outlookcode.com/codedetail.aspx?id=89

finalSubj = ParseTextLinePair를 참조하십시오이 아직도 날을주고있다

Function ParseTextLinePair(strSource As String, strLabel As String) 
Dim intLocLabel As Integer 
Dim intLocCRLF As Integer 
Dim intLenLabel As Integer 
Dim strText As String 

' locate the label in the source text 
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