Error, don't know why

[Brent]

Getting Application Error that reads:

The instruction at "0x77c2a573" referenced memory at "0x00000003". The
memory could not be"written"

Click OK to terminate the program.

I am running ADO/VBA script in Excel. When the scripts are done I close
Excel and it gives me this error. Checked the state of connections and all
are closed upon exit of Excel. Below is my code. Thank you.

Dim rs As Object
Dim rg As Object
Dim rt As Object
Dim cn As Object
Dim fso As Object

Private Sub Workbook_Open()
Workbooks.Application.Visible = False
Set rs = CreateObject("ADODB.Recordset")
Set rg = CreateObject("ADODB.Recordset")
Set rt = CreateObject("ADODB.Recordset")
Set cn = CreateObject("ADODB.Connection")
Set fso = CreateObject("Scripting.FileSystemObject")

cn.Open "Data Source=qse1;User ID=xxxx;Password=xxxx;"
rt.Open "XMLCREATE.AE_UNIT_DATA", cn, 3, 1, 2 '1.3.&h200

again: iptbx = InputBox("Please input file month and folder year(mmyyyy), and
settlement phase (I,F, or T).", , Format(Month(Date),
"00") & "" &
Year(Date))
fdryr = Left(Right(iptbx, 5), 4)
If iptbx = "code" Then 'end 14
Workbooks.Application.Visible = True
SendKeys String:="%{F11}", Wait:=True
ElseIf iptbx = "" Then
Workbooks.Application.Visible = True
Else
If Not fso.folderexists("G:\Settlements\ERCOTDailyFiles\ERCOT_AE_DATA_" &
fdryr) Then 'end 12
fdrerr: dummy = MsgBox("Folder does not exist", 0)
GoTo again
Else

If UCase(Right(iptbx, 1)) = "I" Then 'begin 1
FolderName = "INITIAL"
ElseIf UCase(Right(iptbx, 1)) = "F" Then
FolderName = "FINAL"
ElseIf UCase(Right(iptbx, 1)) = "T" Then
FolderName = "TRUE UP"
Else
GoTo fdrerr
End If 'end 1

filemnth = Left(iptbx, 2)
aplha = 0

exten = "G:\Settlements\ERCOTDailyFiles\ERCOT_AE_DATA_" & fdryr & "\" &
FolderName
With Application.FileSearch 'find all excel files, end 11
.LookIn = exten
.FileType = 4
.SearchSubFolders = True
If .Execute(SortBy:=1, SortOrder:=1) > 0 Then 'end 10
For I = 1 To .FoundFiles.Count 'begin of file loop, end 9
nameofbook = StrReverse(Left(StrReverse
(Application.FileSearch.FoundFiles(I)),
InStr(StrReverse
(Application.FileSearch.FoundFiles(I)), "\") - 1))
If Not Left(nameofbook, 2) = filemnth Then 'end 2
GoTo notit
End If 'end 2
col = 3
rg.activeconnection = cn
rs.activeconnection = cn

Workbooks.Open Application.FileSearch.FoundFiles(I)

Workbooks(nameofbook).Worksheets("MOS_METER_DATA").Activate
lgth = Workbooks(nameofbook).Worksheets("MOS_METER_DATA").Range
("a1").End(xlDown).Row()
wdth = Workbooks(nameofbook).Worksheets("MOS_METER_DATA").Range
("a1").End(xlToRight).Column()
Workbooks(nameofbook).Worksheets("MOS_METER_DATA").Range(Cells(2, 1),
Cells(lgth, wdth)).Sort Key1:=Workbooks(nameofbook).Worksheets
("MOS_METER_DATA").Columns("A") 'sort file by column A
If InStr(nameofbook, "_Revised.xls") Then 'end 3
sttl = FolderName & "_REVISED"
Else
sttl = FolderName
End If 'end 3
strtrws = Columns(1).Find(What:="GSITE", After:=Cells(1, 1),
LookIn:=xlValues,
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False).Row()
fnlrws = strtrws + Application.CountIf(Workbooks(nameofbook).Worksheets
("MOS_METER_DATA").Range("A:A"), "GSITE*")
dys = Right(Left(Range("A1").Value, 10), 4) & "" & Left(Range("A1").Value,
2) & ""
& Right(Left(Range("A1").Value, 5), 2)
Do While col < wdth + 1 'end 8
rws = strtrws
Do While rws < fnlrws 'end 6

rt.movefirst
Do While Not rt.EOF 'end 5
genname = Switch(InStr(rt.fields("ERCOT_UNIT_ID").Value,
"_J01"),
Left(rt.fields("ERCOT_UNIT_ID").Value,
(Len(rt.fields
("ERCOT_UNIT_ID").Value) - 4)),
InStr(rt.fields
("ERCOT_UNIT_ID").Value, "_J04"),
Left(rt.fields
("ERCOT_UNIT_ID").Value, (Len(rt.fields
("ERCOT_UNIT_ID").Value) - 4)),
InStr(rt.fields
("ERCOT_UNIT_ID").Value, "_J02"),
Left(rt.fields
("ERCOT_UNIT_ID").Value, (Len(rt.fields
("ERCOT_UNIT_ID").Value) - 4)), rt.fields
("ERCOT_UNIT_ID").Value > 0, rt.fields
("ERCOT_UNIT_ID").Value)
If InStr(Range("A" & rws).Value, genname) Then 'end 4
ERCOT_UNIT_ID = RTrim(rt.fields("ERCOT_UNIT_ID"))
RECORDER_ID = RTrim(rt.fields("EPS_RECORDER_ID"))
GoTo FINREC
End If 'end 4
rt.movenext
Loop 'end 5
GoTo NEXTROW

FINREC:
interval = Switch(Int((15 * (col - 2)) / 60) = 0, Format(Int((15
* (col -
2)) / 60), "00"), Int((15 * (col - 2)) / 60) < 10,
Format(Int((15 *
(col - 2)) / 60), "0#"), Int((15 * (col - 2)) / 60)

9, Int((15 *

(col - 2)) / 60)) & ":" & Switch((15 * (col - 2))
Mod 60 = 0,
Format((15 * (col - 2)) Mod 60, "00"), (15 * (col -
2)) Mod 60 >
0, (15 * (col - 2)) Mod 60)
PRIMARY_KEY = ERCOT_UNIT_ID & "_" & dys & "" & interval & "_" &
sttl
& "_" & nameofbook

rg.Open "SELECT PRIMARY_KEY FROM TEST WHERE PRIMARY_KEY='" &
PRIMARY_KEY & "'"
If Not rg.EOF Then 'end 7
rg.Close
GoTo NEXTREC
End If 'end 7
rg.Close
Timestamp = Year(Date) & "" & Format(Month(Date), "00") & "" &
Format
(Day(Date), "00") & "" & Format(Hour(Time),
"00") & "" &
Format(Minute(Time), "00") & "" & Format(Second
(Time), "00")
IN_MW = Workbooks(nameofbook).Worksheets
("MOS_METER_DATA").Cells(rws, col).Value
rs.Open "INSERT INTO TEST (PRIMARY_KEY, INTERVAL, SETTLEMENT,
RECORDER_ID, ERCOT_UNIT_ID, DAY, IN_MW,
TIMESTAMP)
VALUES(PRIMARY_KEY, interval, sttl, RECORDER_ID,
ERCOT_UNIT_ID, dys, Timestamp, IN_MW)"
rs.Close
NEXTROW: rws = rws + 1
Loop 'end 6
col = col + 1
Loop 'end 8
alpha = alpha + 1
NEXTREC: Workbooks(nameofbook).Close savechanges:=False

notit: Next I 'end 9
End If 'end 10
End With 'end 11
End If 'end 12

If alpha = 0 Then 'end 13
If MsgBox("No new files found." & Chr(13) & "Nothing Loaded.", 0) Then
End If
ElseIf MsgBox("Load of " & alpha & " new files was Successful.", 0) Then
End If 'end 13
GoTo again
Workbooks.Application.Visible = True
End If 'end 14

Set rg = Nothing
Set rs = Nothing
Set fso = Nothing
If rt.state Then
rt.Close: Set rt = Nothing
End If
If cn.state Then
cn.Close: Set cn = Nothing
End If
End Sub