Email docs from word doc by individual pages

[Holley]

Hello all! I have a manual task that I am sure could be automated - I'm just at a loss of how to do it. I have a text file that I open in a word template with a company logo. There can be up to 70 pages. Each page break will need to be a different email. The email address is in the same location on each page as is the customer #. Would it be possible to run a macro that will copy the text (even if a page at a time), and paste it into an Outlook message? To make it even better is if it could copy the email address and customer # and past in the appropriate fields? Attached is an example of one page. The highlighted fields are static.

Thanks as always!

 

[HighAndWilder]

I had 44 customers and it pulled 17. Each show the customer # at the end of the name. The customer number does show as you have in your example.
View attachment 101847

This is an example of the sort of problem one has when getting data from a text file like this.

Can you please post a few statements, 2 where the # is correct and 2 where it failed.

 

[Holley]

This is an example of the sort of problem one has when getting data from a text file like this.

Can you please post a few statements, 2 where the # is correct and 2 where it failed.

none were correct... each one did as in the example. Am I misunderstanding? When doing at home, it worked, but they were typed manually, but exactly as we have here.

 

[HighAndWilder]

none were correct... each one did as in the example. Am I misunderstanding? When doing at home, it worked, but they were typed manually, but exactly as we have here.

We need to use the text file statements as they come out of the system and not the manually typed ones.

Have you tried it on the system generated file?

 

[Holley]

We need to use the text file statements as they come out of the system and not the manually typed ones.

Have you tried it on the system generated file?

Yes, thats what gave the last results

 

[HighAndWilder]

Yes, thats what gave the last results

I will try a different approach.

Are you able to find a way to save the large file somewhere that I can download it from?

 

[Holley]

I will try a different approach.

Are you able to find a way to save the large file somewhere that I can download it from?

let me see what I can do... they're pretty secure here.

 

[HighAndWilder]

let me see what I can do... they're pretty secure here.

Try this version 2 of the code to extract the data.

It just extracts the customer number in a different way.

The previous method worked for me though.

Private Sub subProcessImport()
Dim strCompany As String
Dim i As Long
Dim ii As Long
Dim arrStatement() As Variant
Dim rng As Range
Dim s As String
Dim intRow As Integer
Dim arrString() As String
Dim arrVariant() As Variant
Dim arrLines() As String
Dim WsImport As Worksheet
Dim WsCustomers As Worksheet
Dim WsStatement As Worksheet
Dim strAccount As String
Dim strVendor As String
Dim lngStatementRow As Long

  ActiveWorkbook.Save

  Set WsCustomers = Worksheets("Customers")
  
  With WsCustomers
    With .Cells
      .Clear
    End With
    .Range("A1:F1").Value = Array("Customer", "Address 1", "Address 2", "Address 3", "Address 4", "Account")
  End With

  Set WsStatement = Worksheets("StatementLines")

  With WsStatement
    With .Cells
      .Clear
    End With
    .Range("A1:E1").Value = Array("Account", "INV NBR", "INV DATE", "AMOUNT", "DUE DATE")
  End With
  
  Set WsImport = Worksheets("Import")
  
  strCompany = WsImport.Range("A1").Value
    
  intRow = 2
  lngStatementRow = 2
 
  For Each rng In WsImport.Range("A1:A" & WsImport.UsedRange.Rows.Count)
      
    ' First line of individual statement.
    If Trim(rng.Value) = strCompany Then
      i = i + 1
    End If
    
    ' Customer number.
    If InStr(1, Trim(rng.Value), "CUST NBR - ", vbTextCompare) > 0 Then
      
      strAccount = ""
      ' Alternative method.
      For i = Len(rng.Value) To 1 Step -1
        If Mid(rng.Value, i, 1) = " " Then
          Exit For
        End If
        strAccount = Mid(rng.Value, i, 1) & strAccount
      Next i
      
      With WsCustomers
        .Cells(intRow, 1).Value = Trim(Replace(rng.Value, "CUST NBR - " & strAccount, "", 1))
        .Cells(intRow, 6).Value = strAccount
      End With
  
      ' how many rows
      arrVariant = rng.Offset(1, 0).Resize(6)
      For i = LBound(arrVariant) To UBound(arrVariant)
        If Trim(arrVariant(i, 1)) <> "" Then
          WsCustomers.Cells(intRow, i + 1).Value = arrVariant(i, 1)
        Else
          Exit For
        End If
      Next i
      intRow = intRow + 1
    
    End If
      
    If Left(rng.Value, 11) = "VENDOR NAME" Then
      
      arrVariant = rng.Offset(1, 0).Resize(30)
      
      For i = LBound(arrVariant) To UBound(arrVariant)
        
        If Trim(arrVariant(i, 1)) = "--------------------" Then
          Exit For
        End If
        
        Do While InStr(1, arrVariant(i, 1), "  ", vbTextCompare) > 0
          arrVariant(i, 1) = Replace(arrVariant(i, 1), "  ", " ", 1)
        Loop
        
        arrLines = Split(arrVariant(i, 1), " ")
             
        WsStatement.Cells(lngStatementRow, 1).Value = strAccount
        
        s = ""
        For ii = UBound(arrLines) - 3 To UBound(arrLines)
          s = s & "," & arrLines(ii)
        Next ii
                
        WsStatement.Range("A" & lngStatementRow & ":E" & lngStatementRow).Value = Split(strAccount & s, ",")
        
        lngStatementRow = lngStatementRow + 1
      
      Next i
    
    End If
        
  Next rng
      
  Call subFormatSheet(WsCustomers)
  
  Call subFormatSheet(WsStatement)
  
  MsgBox "Statement text file has been processed.", vbOKOnly, "Confirmation"
  
End Sub

Private Sub subFormatSheet(Ws As Worksheet)

  With Ws.Range("A1").CurrentRegion
  
    .Font.Size = 14
    .Font.Name = "Arial"
    With .Rows(1)
      .Font.Bold = True
      .Interior.Color = RGB(217, 217, 217)
    End With
    .VerticalAlignment = xlCenter
    .EntireColumn.AutoFit
    With .Borders
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = vbBlack
    End With
 
 End With
    
End Sub

 

[Holley]

Try this version 2 of the code to extract the data.

It just extracts the customer number in a different way.

The previous method worked for me though.

Private Sub subProcessImport()
Dim strCompany As String
Dim i As Long
Dim ii As Long
Dim arrStatement() As Variant
Dim rng As Range
Dim s As String
Dim intRow As Integer
Dim arrString() As String
Dim arrVariant() As Variant
Dim arrLines() As String
Dim WsImport As Worksheet
Dim WsCustomers As Worksheet
Dim WsStatement As Worksheet
Dim strAccount As String
Dim strVendor As String
Dim lngStatementRow As Long

  ActiveWorkbook.Save

  Set WsCustomers = Worksheets("Customers")
 
  With WsCustomers
    With .Cells
      .Clear
    End With
    .Range("A1:F1").Value = Array("Customer", "Address 1", "Address 2", "Address 3", "Address 4", "Account")
  End With

  Set WsStatement = Worksheets("StatementLines")

  With WsStatement
    With .Cells
      .Clear
    End With
    .Range("A1:E1").Value = Array("Account", "INV NBR", "INV DATE", "AMOUNT", "DUE DATE")
  End With
 
  Set WsImport = Worksheets("Import")
 
  strCompany = WsImport.Range("A1").Value
   
  intRow = 2
  lngStatementRow = 2
 
  For Each rng In WsImport.Range("A1:A" & WsImport.UsedRange.Rows.Count)
     
    ' First line of individual statement.
    If Trim(rng.Value) = strCompany Then
      i = i + 1
    End If
   
    ' Customer number.
    If InStr(1, Trim(rng.Value), "CUST NBR - ", vbTextCompare) > 0 Then
     
      strAccount = ""
      ' Alternative method.
      For i = Len(rng.Value) To 1 Step -1
        If Mid(rng.Value, i, 1) = " " Then
          Exit For
        End If
        strAccount = Mid(rng.Value, i, 1) & strAccount
      Next i
     
      With WsCustomers
        .Cells(intRow, 1).Value = Trim(Replace(rng.Value, "CUST NBR - " & strAccount, "", 1))
        .Cells(intRow, 6).Value = strAccount
      End With
 
      ' how many rows
      arrVariant = rng.Offset(1, 0).Resize(6)
      For i = LBound(arrVariant) To UBound(arrVariant)
        If Trim(arrVariant(i, 1)) <> "" Then
          WsCustomers.Cells(intRow, i + 1).Value = arrVariant(i, 1)
        Else
          Exit For
        End If
      Next i
      intRow = intRow + 1
   
    End If
     
    If Left(rng.Value, 11) = "VENDOR NAME" Then
     
      arrVariant = rng.Offset(1, 0).Resize(30)
     
      For i = LBound(arrVariant) To UBound(arrVariant)
       
        If Trim(arrVariant(i, 1)) = "--------------------" Then
          Exit For
        End If
       
        Do While InStr(1, arrVariant(i, 1), "  ", vbTextCompare) > 0
          arrVariant(i, 1) = Replace(arrVariant(i, 1), "  ", " ", 1)
        Loop
       
        arrLines = Split(arrVariant(i, 1), " ")
            
        WsStatement.Cells(lngStatementRow, 1).Value = strAccount
       
        s = ""
        For ii = UBound(arrLines) - 3 To UBound(arrLines)
          s = s & "," & arrLines(ii)
        Next ii
               
        WsStatement.Range("A" & lngStatementRow & ":E" & lngStatementRow).Value = Split(strAccount & s, ",")
       
        lngStatementRow = lngStatementRow + 1
     
      Next i
   
    End If
       
  Next rng
     
  Call subFormatSheet(WsCustomers)
 
  Call subFormatSheet(WsStatement)
 
  MsgBox "Statement text file has been processed.", vbOKOnly, "Confirmation"
 
End Sub

Private Sub subFormatSheet(Ws As Worksheet)

  With Ws.Range("A1").CurrentRegion
 
    .Font.Size = 14
    .Font.Name = "Arial"
    With .Rows(1)
      .Font.Bold = True
      .Interior.Color = RGB(217, 217, 217)
    End With
    .VerticalAlignment = xlCenter
    .EntireColumn.AutoFit
    With .Borders
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = vbBlack
    End With
 
 End With
   
End Sub

Same results.... I'm trying to find a way to save the file to share.