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

目前我正在使用这个脚本,使我的Outlook电子邮件数据总是replaceA1中的数据。

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 ,显然这不起作用。

您需要在顶部插入一个新行

 .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