VBA实现单元格值写入另一个Excel及Outlook自动发邮件技术问询

Here's a straightforward, reliable method to copy values from your current workbook to another Excel file. This example includes error handling to avoid common pitfalls like the target file being missing or already open:

Sub WriteToAnotherWorkbook()
    Dim sourceWB As Workbook
    Dim targetWB As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim targetFilePath As String
    
    ' Define your source workbook and sheet (this is the file running the code)
    Set sourceWB = ThisWorkbook
    Set sourceSheet = sourceWB.Sheets("SourceSheet") ' Replace with your source sheet name
    
    ' Set the full path to your target workbook
    targetFilePath = "C:\Documents\TargetWorkbook.xlsx" ' Update this path
    
    ' Check if the target workbook is already open
    On Error Resume Next
    Set targetWB = Workbooks(targetFilePath)
    On Error GoTo 0
    
    ' If not open, open it
    If targetWB Is Nothing Then
        Set targetWB = Workbooks.Open(targetFilePath)
    End If
    
    Set targetSheet = targetWB.Sheets("TargetSheet") ' Replace with your target sheet name
    
    ' Write values from source to target (customize these ranges as needed)
    targetSheet.Range("A1").Value = sourceSheet.Range("B2").Value ' Copy B2 from source to A1 in target
    targetSheet.Range("A2:A5").Value = sourceSheet.Range("C2:C5").Value ' Copy a range of cells
    
    ' Save and close the target workbook (remove .Close if you want to keep it open)
    targetWB.Save
    targetWB.Close SaveChanges:=False ' False because we already saved
    
    ' Clean up memory by releasing object references
    Set targetSheet = Nothing
    Set targetWB = Nothing
    Set sourceSheet = Nothing
    Set sourceWB = Nothing
End Sub

Key Notes: #

• Use ThisWorkbook to reference the file containing your VBA code (avoids confusion if multiple workbooks are open).
• Always check if the target file exists before trying to open it (you can add an extra check with Dir(targetFilePath) <> "" if needed).
• If you don’t want to overwrite existing data in the target file, add logic to find the next empty row (e.g., targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1).

Your partial code is a great start! Let’s finish it, add best practices like error handling, and make it more maintainable by separating email logic into a helper sub:

Sub AutoEmail()
    On Error GoTo ErrorHandler
    
    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 + vbQuestion) ' Using explicit constants makes code easier to read
    
    Select Case Resp
        Case vbYes ' User wants to review the email first
            SendEmail showMail:=True
        Case vbNo ' Send without reviewing
            SendEmail showMail:=False
        Case vbCancel ' Abort the operation
            Exit Sub
    End Select
    
    Exit Sub
    
ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbExclamation
End Sub

' Helper sub to handle email creation and sending logic
Private Sub SendEmail(showMail As Boolean)
    Dim otlApp As Object
    Dim myMailItem As Object
    Dim attachmentPath As String
    
    ' Create an Outlook instance (late binding, no need to set references)
    Set otlApp = CreateObject("Outlook.Application")
    Set myMailItem = otlApp.CreateItem(0) ' 0 = olMailItem (standard email)
    
    ' Configure your email details
    With myMailItem
        .To = "recipient@example.com" ' Replace with your recipient's email
        .CC = "cc.recipient@example.com" ' Optional: add CC addresses
        .BCC = "bcc.recipient@example.com" ' Optional: add BCC addresses
        .Subject = "Automated Email from Excel" ' Update your subject line
        .Body = "Hello," & vbCrLf & vbCrLf & _
                "This is an automated email sent from Excel using VBA." & vbCrLf & vbCrLf & _
                "Regards," & vbCrLf & _
                "Your Name" ' Customize the email body
        
        ' Add an attachment (optional)
        attachmentPath = "C:\Documents\Attachment.xlsx" ' Update attachment path
        If Dir(attachmentPath) <> "" Then ' Only add if the file exists
            .Attachments.Add attachmentPath
        End If
        
        ' Either display the email for review or send it immediately
        If showMail Then
            .Display
        Else
            .Send
        End If
    End With
    
    ' Clean up object references
    Set myMailItem = Nothing
    Set otlApp = Nothing
End Sub

Key Improvements: #

• Error Handling: Added an error handler to catch and display issues (e.g., Outlook not running, invalid file paths).
• Late Binding: Uses CreateObject so you don’t need to set a reference to the Outlook object library (works across different Excel/Outlook versions).
• Helper Sub: Separates the email logic from the user prompt, making the code easier to modify and reuse.
• Explicit Constants: Uses vbYesNoCancel instead of numeric values (3) for readability.
• Attachment Check: Verifies the attachment exists before trying to add it, preventing errors.

Important Note: #

Outlook may block automated emails by default. To fix this, you’ll need to enable trusted macros in Excel/Outlook, or use Outlook’s security settings to allow programmatic access (check Outlook’s Trust Center for options).

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