Question

我每天有大约200封电子邮件，语法如下：

Hi,

These are our clients.

548628797 FV    THD EHSI  34215564824 JUAN CARLOS CORENDA ALVARES 1          31,43
243234133 FV    THD EHSI  752520934982 JUAN CARLOS CORENDA ALVARES 2          2,8
2340291438 RFR   WER IRJF 323442342312 CARLITO HIMAT            3,00
324 EHTF  TGS HKTY  32423      WILLIAM TARING                1,2

Thank you!

我是否在＃34之间提取线条;这些是我们的客户。＆＃34;和＃34;谢谢！＆＃34; ？有些电子邮件只有1行，有些则有20或更多。或者最好从第4行提取到结束1？
在excel中，如果我粘贴这些行，名称将在不同的单元格中分隔。我试过了：
```
=IF(COUNT(FIND({0,1,2,3,4,5,6,7,8,9},J2))>0, K2&" "&L2&" "&M2&" "&N2, "NO NUMBERS IN J2") 
```
但是，我怎么能停止连接名称，直到它以金额命中单元？
当在Excel中粘贴时，它会忽略分隔符＆＃34;，＆＃34;只是给了我而不是31,43 3143金额，我必须将其粘贴到正确的金额。但是如果我粘贴文本，那么整行将被插入一个不在不同单元格中的单元格中。

我之前的代码可以从电子邮件中提取表数据，但我不知道如何将代码实现到当前的问题 - 首先是因为我不知道如何查看提取。在excel中提取正文并用""替换前3行和最后一行，然后将这些行拆分为列或行。

从我发现到目前为止的行的布局是：

1到13 char
1个空间
2到4 char
如果前一个有2个字符然后是4个空格/如果是3个字符则是3个空格/如果是4个字符然后是2个空格
4 char总是
1到11个空格
1到15 char
1到5个空格
最多7个名字（西班牙名字）的名称，最后可以有数字
1至20个空格
金额可以是1,00或1，可以是000000000001,15（有些错误，他们无法纠正）

当前代码：

Sub exporttheirclients()

Const FOLDER_PATH = "\\Mailbox - ME\Their clients"
Dim olkMsg As Object, _
    olkFld As Object, _
    excApp As Object, _
    excWkb As Object, _
    excWks As Object, _
    intRow As Integer, _
    intCnt As Integer, _
    data_email As String, _
    strFilename As String, _
    arrCells As Variant, _
    varb As Variant, varD As Variant, varF As Variant

Dim sinceDt, toDt As Date
sinceDt = InputBox("STARTING PERIOD")
toDt = InputBox("ENDING PERIOD")

strFilename = "C:\THEIR CLIENTS\xlsx\TCLIENTS"
If strFilename <> "" Then
    Set excApp = CreateObject("Excel.Application")
    Set excWkb = excApp.Workbooks.Add()
    Set excWks = excWkb.ActiveSheet
    excApp.DisplayAlerts = False
    With excWks
        .Cells(1, 1) = "SUBJECT"
        .Cells(1, 2) = "DATE"
        .Cells(1, 3) = "REF NR"
        .Cells(1, 4) = "AMOUNT"
        .Cells(1, 5) = "CITY"
    End With
    intRow = 2
    Set olkFld = OpenOutlookFolder(FOLDER_PATH)

    For Each olkMsg In olkFld.Items
        data_email = olkMsg.ReceivedTime
        If olkMsg.Class = olMail Then
            If data_email >= sinceDt And data_email <= toDt + 1 Then
                arrCells = Split(GetCells(olkMsg.HTMLBody), Chr(255))
                For intCnt = LBound(arrCells) To UBound(arrCells) Step 16
                    On Error GoTo Handler
                    varb = arrCells(intCnt + 1)
                    varD = arrCells(intCnt + 3)
                    varF = arrCells(intCnt + 5)

                    excWks.Cells(intRow, 1) = olkMsg.Subject
                    excWks.Cells(intRow, 2) = Left(olkMsg.ReceivedTime, 10)
                    excWks.Cells(intRow, 3) = varb
                    excWks.Cells(intRow, 4) = varD 
                    excWks.Cells(intRow, 5) = Left(varF, 4)
                    intRow = intRow + 1
                Next
            End If
        End If
    Label1:
    Next
    Set olkMsg = Nothing
    excWkb.SaveAs strFilename, 52
    excWkb.Close
    End If
    Set olkFld = Nothing
    Set excWks = Nothing
    Set excWkb = Nothing
    Set excApp = Nothing

    MsgBox "Ta dam! They have been exported ", vbInformation + vbOKOnly
    Call opexl
    Exit Sub
    Handler:
    Dim myOutlookFolders As Outlook.Folder
    Dim myDestFolder As Outlook.Folder
    Set myOutlookFolders = Session.GetDefaultFolder(olFolderInbox)
    Set myDestFolder = Session.Folders("Mailbox - ME").Folders("Their clients").Folders("Manually input")

    If olkMsg <> "Nothing" Then

        olkMsg.Move myDestFolder
        MsgBox "An email has been found with a problem. The search continues..."

    Else: End

End If
Resume Label1:

End Sub

从Outlook电子邮件中提取数据到excel

0 个答案: