將數據插入到第一行而不是工作表的最後一行

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