Outlook发文件VBA代码存Excel数据至同一行，需改为写入下一空行

Got it, let's fix that annoying issue where your VBA code keeps writing data to the same Excel row! The root problem is almost certainly hardcoded row references (like Range("A2")) instead of dynamically finding the first blank row. Here's how to adjust your code properly:

Key Concept: Locate the Next Empty Row #

Use this snippet to get the row number of the first blank row in your target column (we'll use column A as an example—adjust the letter if you start elsewhere):

Dim nextEmptyRow As Long
nextEmptyRow = ThisWorkbook.Sheets("YourSheetName").Cells(Rows.Count, "A").End(xlUp).Row + 1

• Rows.Count grabs the total number of rows in the sheet (works for all Excel versions)
• .End(xlUp) mimics pressing Ctrl+Up from the bottom of the column to find the last filled row
• +1 shifts to the row right below that (your first empty row)

Modified Full Code Snippet #

Here's your AutoEmail sub with the Excel write logic updated to use dynamic rows:

Sub AutoEmail()
    On Error GoTo Cancel
    
    Dim Resp As Integer
    Resp = MsgBox(prompt:=vbCr & "Yes = Review Email" & vbCr & "No = Immediately Send" & vbCr & "Cancel = Cancel" & vbCr, _
                  Title:="Review email before sending?", _
                  Buttons:=vbYesNoCancel)
    
    If Resp = vbCancel Then GoTo Cancel
    
    ' --- Outlook Email Logic (your existing working code) ---
    Dim olApp As Object
    Dim olMail As Object
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    
    With olMail
        .To = "recipient@example.com" ' Replace with your actual recipient
        .Subject = "Auto-Email with Attachment"
        .Body = "Hello, please find the attached file."
        .Attachments.Add "C:\Path\To\Your\File.pdf" ' Replace with your file path
        If Resp = vbYes Then
            .Display
        Else
            .Send
        End If
    End With
    
    ' --- Excel Data Write Logic (UPDATED FOR NEXT EMPTY ROW) ---
    Dim ws As Worksheet
    Dim nextEmptyRow As Long
    
    ' Set reference to your target worksheet (replace "EmailLog" with your sheet name)
    Set ws = ThisWorkbook.Sheets("EmailLog")
    
    ' Calculate next empty row in column A
    nextEmptyRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
    
    ' Write your data to the new row (adjust columns/values to match your needs)
    ws.Cells(nextEmptyRow, "A").Value = Now() ' Timestamp of send
    ws.Cells(nextEmptyRow, "B").Value = "Email Sent" ' Status
    ws.Cells(nextEmptyRow, "C").Value = "recipient@example.com" ' Recipient email
    
    ' Clean up objects to avoid memory leaks
    Set olMail = Nothing
    Set olApp = Nothing
    Set ws = Nothing
    
    MsgBox "Email processed and log updated successfully!", vbInformation
    Exit Sub
    
Cancel:
    MsgBox "Operation cancelled or an error occurred.", vbExclamation
    ' Clean up objects even if there's an error
    If Not olMail Is Nothing Then Set olMail = Nothing
    If Not olApp Is Nothing Then Set olApp = Nothing
    If Not ws Is Nothing Then Set ws = Nothing
End Sub

Quick Adjustments for Your Use Case #

• Replace YourSheetName with the actual name of your Excel worksheet (e.g., "SendLog")
• Tweak the column letters (A, B, C) and values to match the data you want to record
• If your sheet might have empty rows in the middle of your log, use this more robust method to find the last filled row:

  Dim lastRow As Range
  Set lastRow = ws.Columns("A").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows)
  nextEmptyRow = IIf(lastRow Is Nothing, 2, lastRow.Row + 1) ' Starts at row 2 if column A is empty
  

内容的提问来源于stack exchange，提问作者Mert Dogan