不一致的运行时错误5，但并非总是

Question

我使用的 VBA 子程序工作不一致。该子基于之前的 Stack Overflow 线程答案，我发现它工作时是完美的。 将数据从 Excel 复制到记事本。

Sub CopyEventtoNotepad()

    'Dim rngData As Range
    Dim strData As String
    Dim strTempFile As String
    Dim strPath As String
    
strPath = Environ("USERPROFILE") & "\Desktop\HBT.txt"
    

Set Meeting = Worksheets("Patient").Range("CN21:CO55")
Set MeetingComments = Worksheets("Patient").Range("CN21:CO58")
Set Phone = Worksheets("Patient").Range("CS21:CT33")
Set PhoneComments = Worksheets("Patient").Range("CS21:CT36")
    
If Worksheets("Patient").Range("BB9").Value = 1 Then MeetingComments.Copy
If Worksheets("Patient").Range("BB9").Value = 2 Then Meeting.Copy
If Worksheets("Patient").Range("BB9").Value = 3 Then PhoneComments.Copy
If Worksheets("Patient").Range("BB9").Value = 4 Then Phone.Copy

    ' get the clipboard data
    ' magic code for is for early binding to MSForms.DataObject
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        strData = .GetText
    End With

    ' write to temp file
    strTempFile = strPath
    With CreateObject("Scripting.FileSystemObject")
        ' true to overwrite existing temp file
        .CreateTextFile(strTempFile, True).Write strData
    End With

    ' open notepad with tempfile
    Shell "cmd /c ""notepad.exe """ & strTempFile & """", vbHide

End Sub

运行时错误发生在以下行：

.CreateTextFile(strTempFile, True).Write strData

我几周来一直试图确定触发运行时错误 5 的变量因素是什么。我找不到模式。

谢谢

Answer 1

前几天复制范围要串起

• ，有人在评论中提到DAO据称由于窗口或办公室的更新而无法正常工作。
• 无论如何，这是一个简单的解决方法，可以为您提供如此小的范围。

Option Explicit

Sub CopyEventToNotepad()

    Dim rgAddresses As Variant
    rgAddresses = VBA.Array("CN21:CO55", "CN21:CO58", "CS21:CT33", "CS21:CT36")

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Worksheets("Patient")
    Dim rg As Range: Set rg = ws.Range(rgAddresses(ws.Range("BB9").Value - 1))

    Dim FilePath As String
    FilePath = Environ("USERPROFILE") & "\Desktop\HBT.txt"
    
    Dim RangeString As String: RangeString = StringRangeRows(rg)

    With CreateObject("Scripting.FileSystemObject")
        .CreateTextFile(FilePath, True).Write RangeString
    End With

    Shell "cmd /c ""notepad.exe """ & FilePath & """", vbHide

End Sub

Function StringRangeRows( _
    ByVal rg As Range, _
    Optional ByVal CellDelimiter As String = vbTab, _
    Optional ByVal LineDelimiter As String = vbLf) _
As String
    
    Dim cLen As Long: cLen = Len(CellDelimiter)
    
    Dim arg As Range, rrg As Range, rCell As Range, RangeString As String
    
    For Each arg In rg.Areas
        For Each rrg In arg.Rows
            For Each rCell In rrg.Cells
                RangeString = RangeString & CStr(rCell.Value) & CellDelimiter
            Next rCell
            RangeString = Left(RangeString, Len(RangeString) - cLen) _
                & LineDelimiter
        Next rrg
    Next arg
    
    StringRangeRows = Left(RangeString, Len(RangeString) - Len(LineDelimiter))

End Function