Excel VBA保存文件及导出用户窗体时出现系统错误与文件未找到问题

根据你描述的场景——韩语版Excel 2007在Win7更新后，保存带VBA的文件或导出用户窗体时频繁触发「文件未找到」和&H8000FFFF系统错误，且常规的新建窗口粘贴、修改文件名/路径都无效——我整理了几个针对性的排查和解决方向，结合你的代码给出具体建议：

1. 先排查Office组件或系统权限问题 #

Win7的更新很可能改动了系统权限设置，或者意外损坏了Excel的VBA相关组件，先从基础修复入手：

• 修复Office 2007安装：打开控制面板→程序和功能→找到Microsoft Office 2007→右键选「更改」→选择「快速修复」（不行就选「联机修复」），完成后重启电脑再测试。这一步能解决大部分组件损坏导致的VBA操作异常。
• 确保保存路径有完全权限：你代码里用到的\눈레포트 첨부 엑셀파일\文件夹，右键它→属性→安全→编辑→添加当前登录用户→勾选「完全控制」→应用。系统更新后可能会重置文件夹权限，导致Excel无法写入文件。
• 临时调低UAC测试：Win7的用户账户控制（UAC）可能拦截了Excel的文件操作，暂时把UAC拉到最低（控制面板→用户账户→更改用户账户控制设置），测试后记得调回，避免安全风险。

2. 处理韩语路径/文件名的编码兼容问题 #

韩语字符在文件路径中容易因为系统更新后的编码适配问题出错，试试这些调整：

• 临时切换纯英文路径测试：把保存路径改成C:\Temp\这种纯英文路径，文件名也换成Position_Report_20240520.xlsx这类英文格式，如果不再报错，说明是韩语字符的兼容问题。
• 代码中添加文件夹存在判断：你当前代码直接拼接路径保存，但如果目标文件夹不存在，就会触发「文件未找到」错误。建议在保存前先检查并创建文件夹：

  Dim saveFolder As String
  saveFolder = 매크로파일경로 & "\눈레포트 첨부 엑셀파일\"
  ' 检查文件夹是否存在，不存在则创建
  If Dir(saveFolder, vbDirectory) = "" Then
      MkDir saveFolder
  End If
  

3. 修复代码中的潜在隐患 #

看你提供的VBA代码，有几个细节可能引发文件相关错误：

• 处理ThisWorkbook.Path为空的情况：如果当前工作簿从未保存过，ThisWorkbook.Path会是空字符串，导致路径拼接完全错误。建议在代码开头添加判断：

  If ThisWorkbook.Path = "" Then
      MsgBox "请先保存当前工作簿后再执行宏！", vbExclamation
      Exit Function
  End If
  

• 恢复DisplayAlerts默认设置：你设置了Application.DisplayAlerts = False来屏蔽保存提示，但没有在操作后恢复，可能导致后续的文件操作提示被屏蔽，隐藏真实错误。在ActiveWorkbook.Close后加上：

  Application.DisplayAlerts = True ' 恢复默认的提示设置
  

• 检查附件路径的一致性：你在保存和添加附件时用了相同的路径，但如果保存过程中出现异常，文件可能没有生成，建议添加文件存在判断再添加附件：

  Dim attachPath As String
  attachPath = 매크로파일경로 & "\눈레포트 첨부 엑셀파일\" & Format(Date, "yyyy-mm-dd") & " " & "Position Report Ver.3 MEIN.xlsx"
  If Dir(attachPath) <> "" Then
      .Attachments.Add attachPath
  Else
      MsgBox "附件文件未找到：" & attachPath, vbExclamation
  End If
  

4. 用户窗体导出的特殊处理 #

如果是导出用户窗体时报错，试试：

• 关闭所有无关工作簿：只保留当前带VBA的工作簿，避免其他工作簿占用系统资源或干扰导出操作。
• 手动导出到纯英文路径：右键用户窗体→导出→选择纯英文的文件夹保存，不要用包含韩语字符的路径。

你的示例VBA代码（格式化后） #

Function NPP메일보내기함수()
    '//ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Date & " " & "Position Report Ver.2.xlsx", FileFormat:=51
    '//xlsm은 52
    '//위 방법은 xlsx 저장은 잘 되나 아래와 같은 문제가 있다.
    '//I have a Excel sheet, and if I save the file using the Save as... option in Excel VBA the currently open document would close, and switch over to the newly created document.
    '//How can I save a copy of the document without switching over the control?
    '//해결하려면 여러가지 방법이 있다. 여기엔 하나만 적는다. 아래와 같이 하는건 잘못된 방법이다. SaveCopyAS는 확장자 못 바꿈.
    '//ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & Date & " " & "Position Report Ver.2 MEIN.xlsx"
    '//, FileFormat:=51
    '//위 방법은 새창으로 안 열리기는 하나 확장자가 안 바뀌는.
    '//아래 방법이 새창으로 안 열리면서 확장자도 바뀌는 완벽한 방법임.
    '
    ' Dim wb As Workbook, pstr As String
    '
    ' pstr = ThisWorkbook.Path & "\" & Date & " Position Report Ver. 02 MEIN" & ".xlsm"
    ' ActiveWorkbook.SaveCopyAs Filename:=y
    '
    ' Set wb = Workbooks.Open(pstr)
    ' wb.SaveAs Left(pstr, Len(pstr) - 1) & "x", 52
    ' wb.Close False
    '
    ' Kill pstr ' 오류뜸
    '//http://www.excely.com/excel-vba/save-workbook-as-new-file.shtml
    ThisWorkbook.Sheets.Copy
    Application.DisplayAlerts = False
    Dim 매크로파일경로 As String
    매크로파일경로 = ThisWorkbook.Path
    ActiveWorkbook.SaveAs 매크로파일경로 & "\눈레포트 첨부 엑셀파일\" & Format(Date, "yyyy-mm-dd") & " " & "Position Report Ver.3 MEIN.xlsx", FileFormat:=51
    ActiveWorkbook.Close
    On Error GoTo Error_Handler
    Dim oOutlook As Object
    Dim sAPPPath As String
    If IsAppRunning("Outlook.Application") = True Then
        'Outlook was already running
        Set oOutlook = GetObject(, "Outlook.Application") 'Bind to existing instance of Outlook
    Else
        'Could not get instance of Outlook, so create a new one
        sAPPPath = GetAppExePath("outlook.exe") 'determine outlook's installation path
        Shell (sAPPPath) 'start outlook
        Do While Not IsAppRunning("Outlook.Application")
            DoEvents
        Loop
        Set oOutlook = GetObject(, "Outlook.Application") 'Bind to existing instance of Outlook
    End If
    ' MsgBox "Outlook Should be running now, let's do something"
    Const olMailItem = 0
    Dim oOutlookMsg As Object
    Set oOutlookMsg = oOutlook.CreateItem(olMailItem) 'Start a new e-mail message
    Dim 보낼메세지 As String
    Dim 반복문카운터 As Integer
    For 반복문카운터 = 95 To 127
        보낼메세지 = 보낼메세지 & ThisWorkbook.Worksheets("NPP").Range("C" & 반복문카운터).Value & Chr(13) & Chr(10)
    Next
    With oOutlookMsg
        .To = "해사운항팀"
        .CC = " 사업안전팀; 최종범차장; 조달팀; 공무팀; 사업팀; 박준영대리; 고현해운"
        .BCC = ""
        .Subject = Range("C99").Value
        '// .Body = Range("C95:C127").Value 요렇게 하면 안돼요.
        .Body = 보낼메세지
        '//Attachments를 Attachment라고 써서 에러가 나던 것.
        .Attachments.Add 매크로파일경로 & "\눈레포트 첨부 엑셀파일\" & Format(Date, "yyyy-mm-dd") & " " & "Position Report Ver.3 MEIN.xlsx"
        '//ThisWorkbook.Path하니까 파일이 없다는 오류가 나서 시도해봄.
        .Display 'Show the message to the user
    End With
Error_Handler_Exit:
    On Error Resume Next
    Set oOutlook = Nothing
    Exit Function
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: StartOutlook" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : IsAppRunning
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Determine is an App is running or not
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sApp : GetObject Application to verify if it is running or not
'
' Usage:
' ~~~~~~
' IsAppRunning("Outlook.Application")
' IsAppRunning("Excel.Application")
' IsAppRunning("Word.Application")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2014-Oct-31 Initial Release
'---------------------------------------------------------------------------------------
Function IsAppRunning(sApp As String) As Boolean
    On Error GoTo Error_Handler
    Dim oApp As Object
    Set oApp = GetObject(, sApp)
    IsAppRunning = True
Error_Handler_Exit:
    On Error Resume Next
    Set oApp = Nothing
    Exit Function
Error_Handler:
    Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetAppExePath
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Determine the path for a given exe installed on the local computer
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sEXEName : Name of the exe to locate
'
' Usage:
' ~~~~~~
' Call GetAppExePath("msaccess.exe")
' GetAppExePath("firefox.exe")
' GetAppExePath("outlook.exe")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2014-Oct-31 Initial Release
'---------------------------------------------------------------------------------------
Function GetAppExePath(ByVal sExeName As String) As String
    On Error GoTo Error_Handler
    Dim WSHShell As Object
    Set WSHShell = CreateObject("Wscript.Shell")
    GetAppExePath = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\" & sExeName & "\")
Error_Handler_Exit:
    On Error Resume Next
    Set WSHShell = Nothing
    Exit Function
Error_Handler:
    If Err.Number = -2147024894 Then
        'Cannot locate requested exe????
    Else
        MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: GetAppExePath" & vbCrLf & _
               "Error Description: " & Err.Description, _
               vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Function

内容的提问来源于stack exchange，提问作者박영종