Inconsistently getting runtime error 5 but not always - excel

Question

I am using a VBA sub which works inconsistently. The sub is based on a previous Stack Overflow thread answer I found which when it works is perfect. Copy Data from Excel to Notepad.
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
The runtime error occurs at the following line:
.CreateTextFile(strTempFile, True).Write strData
I have been trying to identify what the variable factor is that triggers the runtime error 5 for weeks. I can't find a pattern.
Thanks

Answer 1

Copy Range to String
The other day, someone mentioned in the comments that Dao is not working supposedly due to a Windows or Office update.
Anyways, here's a simple workaround that may serve you well for such small ranges.
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