将数据插入到第一行而不是工作表的最后一行

Question

目前，我正在使用此脚本使Outlook电子邮件中的数据始终替换A1中的数据。

Const xlUp As Long = -4162 

Sub ExportToExcel(MyMail As MailItem) 
    Dim strID As String, olNS As Outlook.NameSpace 
    Dim olMail As Outlook.MailItem 
    Dim strFileName As String 

    '~~> Excel Variables 
    Dim oXLApp As Object, oXLwb As Object, oXLws As Object 
    Dim lRow As Long 

    strID = MyMail.EntryID 
    Set olNS = Application.GetNamespace("MAPI") 
    Set olMail = olNS.GetItemFromID(strID) 

    '~~> Establish an EXCEL application object 
    On Error Resume Next 
    Set oXLApp = GetObject(, "Excel.Application") 

    '~~> If not found then create new instance 
    If Err.Number <> 0 Then 
     Set oXLApp = CreateObject("Excel.Application") 
    End If 
    Err.Clear 
    On Error GoTo 0 

    '~~> Show Excel 
    oXLApp.Visible = True 

    '~~> Open the relevant file 
    Set oXLwb = oXLApp.Workbooks.Open("C:\Users\admin\Desktop\Control Panel.xlsm") 

    '~~> Set the relevant output sheet. Change as applicable 
    Set oXLws = oXLwb.Sheets("Sheet1") 

    lRow = oXLws.Range("A" & oXLApp.Rows.Count).End(xlUp).Row + 0 

    '~~> Write to outlook 
    With oXLws 
     ' 
     '~~> Code here to output data from email to Excel File 
     '~~> For example 
     ' 
     .Range("A" & lRow).Value = olMail.Body 
     ' 
    End With 

    '~~> Close and Clean up Excel 
    oXLwb.save 
    Set oXLws = Nothing 
    Set oXLwb = Nothing 
    Set oXLApp = Nothing 

    Set olMail = Nothing 
    Set olNS = Nothing 
End Sub 

如果Row + 0使其覆盖数据， 和Row + 1使它进入下一个可用的电池，我怎样才能让这个最新的数据总是会进入例如，A1，然后使旧的信息向下移动？

任何提示赞赏。在理解脚本方面，我不是很聪明。我试过Row - 1，显然它没有工作。

Answer 1

你需要在顶部插入新行与

.Rows(fRow).Insert Shift:=xlDown 

之前，你可以写在第一行与

.Range("A" & fRow).Value = olMail.Body 

如果你已经在你的表格标题行，你需要设置fRow到第一个数据行：

• 例如如果你有一个标题行设置fRow = 2
• 如果你没有任何标题行设置fRow = 1

---

所以我们造成这样的事情：

Sub ExportToExcel(MyMail As MailItem) 
    Dim strID As String, olNS As Outlook.Namespace 
    Dim olMail As Outlook.MailItem 
    Dim strFileName As String 

    '~~> Excel Variables 
    Dim oXLApp As Object, oXLwb As Object, oXLws As Object 
    Dim lRow As Long, fRow As Long 

    strID = MyMail.EntryID 
    Set olNS = Application.GetNamespace("MAPI") 
    Set olMail = olNS.GetItemFromID(strID) 

    '~~> Establish an EXCEL application object 
    On Error Resume Next 
    Set oXLApp = GetObject(, "Excel.Application") 

    '~~> If not found then create new instance 
    If Err.Number <> 0 Then 
     Set oXLApp = CreateObject("Excel.Application") 
    End If 
    Err.Clear 
    On Error GoTo 0 

    '~~> Show Excel 
    oXLApp.Visible = True 

    '~~> Open the relevant file 
    Set oXLwb = oXLApp.Workbooks.Open("C:\Users\admin\Desktop\Control Panel.xlsm") 

    '~~> Set the relevant output sheet. Change as applicable 
    Set oXLws = oXLwb.Sheets("Sheet1") 

    '~~> Write to outlook 
    With oXLws 
     '~~> Code here to output data from email to Excel File 
     '~~> For example 

     '* insert into last row (old alternative) 
     '* you can remove this and the declare of lRow (at the top) if you don't need the old last row insert anymore. 
     'lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'next new row 
     '.Range("A" & lRow).Value = olMail.Body 'write into last row 

     '* insert into first row 
     fRow = 1 'first row 
     .Rows(fRow).Insert Shift:=xlDown 'insert a blank row before first row 
     .Range("A" & fRow).Value = olMail.Body 'write into first row 
    End With 

    '~~> Close and Clean up Excel 
    oXLwb.Save 
    Set oXLws = Nothing 
    Set oXLwb = Nothing 
    Set oXLApp = Nothing 

    Set olMail = Nothing 
    Set olNS = Nothing 
End Sub