Using code rs.AddNew for a recordset, and I have placed the call at the
beginning of my code. I then check to see if the Primary Key is violated, if
not the program proceeds, but if the PK is violated the program goes to the
next record. Since you cannot close rs.AddNew (at least from what I
understand) I must have it outside the loop. If no records with new PKs are
found the program ends. The problem then is that I cannot perform rs.Close
and I get an error message "memory could not be written." Is there a way
around this? Thank you.

Brent

Couldn't you use

If PK is not violated then
rs.AddNew
...
End If


It would help if you posted some of your code.

--
urkec


"Brent" wrote:

Using code rs.AddNew for a recordset, and I have placed the call at the
beginning of my code. I then check to see if the Primary Key is violated, if
not the program proceeds, but if the PK is violated the program goes to the
next record. Since you cannot close rs.AddNew (at least from what I
understand) I must have it outside the loop. If no records with new PKs are
found the program ends. The problem then is that I cannot perform rs.Close
and I get an error message "memory could not be written." Is there a way
around this? Thank you.

Brent

this is all of it, took out some calculations for variables and just noteed
what they are. Thank you.

Brent


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=;Password=;"
rs.Open "TEST", cn, 0, 2, &H200
rt.Open "XMLCREATE.AE_UNIT_DATA", cn, 3, 1, 2 '1.3.&h200
rs.addnew

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\E RCOT_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

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).Workshee ts
("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)))
If InStr(Range("A" & rws).Value, genname) Then 'end 4
rs.fields("ERCOT_UNIT_ID") =
rt.fields("ERCOT_UNIT_ID")
rs.fields("RECORDER_ID") =
rt.fields("EPS_RECORDER_ID")
GoTo FINREC
End If 'end 4
rt.movenext
Loop 'end 5
GoTo NEXTROW

FINREC: rs.fields("Settlement") = sttl
rs.fields("Interval") = switch statement
rs.fields("PRIMARY_KEY") = multiple fields combined
rg.Open "SELECT PRIMARY_KEY FROM TEST WHERE PRIMARY_KEY='" &
rs.fields("PRIMARY_KEY") & "'"
If Not rg.EOF Then 'end 7
rg.Close
GoTo NEXTREC
End If 'end 7
rg.Close

rs.fields("IN_MW") = Workbooks(nameofbook).Worksheets
("MOS_METER_DATA").Cells(rws, col).Value
rs.fields("Day") = dys
rs.fields("Timestamp") = calculated time
rs.fields("Hour") = calculated hour
rs.Update
rs.addnew
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
rt.Close
Set rt = Nothing
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

"urkec" wrote:

Couldn't you use

If PK is not violated then
rs.AddNew
...
End If


It would help if you posted some of your code.

--
urkec


"Brent" wrote:

Using code rs.AddNew for a recordset, and I have placed the call at the
beginning of my code. I then check to see if the Primary Key is violated, if
not the program proceeds, but if the PK is violated the program goes to the
next record. Since you cannot close rs.AddNew (at least from what I
understand) I must have it outside the loop. If no records with new PKs are
found the program ends. The problem then is that I cannot perform rs.Close
and I get an error message "memory could not be written." Is there a way
around this? Thank you.

Brent

I was thinking that you could first check if the primary key already exists,
and if not use AddNew and Update.

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source='C:\dbase.mdb';"

For Pkey = 1 To 20

strSQL = "select * from [Test] " & _
"where PK = " & Pkey

rs.Open strSQL, cnn, 3, 3

If Not rs.EOF Then
Debug.Print "PK already exists"
Else
rs.AddNew
rs!PK = Pkey
rs!Field1 = "test" & CStr(Pkey)
rs.Update
End If

rs.Close

Next


Hope that helps some.

--
urkec


"Brent" wrote:

this is all of it, took out some calculations for variables and just noteed
what they are. Thank you.

Brent


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=;Password=;"
rs.Open "TEST", cn, 0, 2, &H200
rt.Open "XMLCREATE.AE_UNIT_DATA", cn, 3, 1, 2 '1.3.&h200
rs.addnew

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\E RCOT_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

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).Workshee ts
("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)))
If InStr(Range("A" & rws).Value, genname) Then 'end 4
rs.fields("ERCOT_UNIT_ID") =
rt.fields("ERCOT_UNIT_ID")
rs.fields("RECORDER_ID") =
rt.fields("EPS_RECORDER_ID")
GoTo FINREC
End If 'end 4
rt.movenext
Loop 'end 5
GoTo NEXTROW

FINREC: rs.fields("Settlement") = sttl
rs.fields("Interval") = switch statement
rs.fields("PRIMARY_KEY") = multiple fields combined
rg.Open "SELECT PRIMARY_KEY FROM TEST WHERE PRIMARY_KEY='" &
rs.fields("PRIMARY_KEY") & "'"
If Not rg.EOF Then 'end 7
rg.Close
GoTo NEXTREC
End If 'end 7
rg.Close

rs.fields("IN_MW") = Workbooks(nameofbook).Worksheets
("MOS_METER_DATA").Cells(rws, col).Value
rs.fields("Day") = dys
rs.fields("Timestamp") = calculated time
rs.fields("Hour") = calculated hour
rs.Update
rs.addnew
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
rt.Close
Set rt = Nothing
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

"urkec" wrote:

Couldn't you use

If PK is not violated then
rs.AddNew
...
End If


It would help if you posted some of your code.

--
urkec


"Brent" wrote:

Using code rs.AddNew for a recordset, and I have placed the call at the
beginning of my code. I then check to see if the Primary Key is violated, if
not the program proceeds, but if the PK is violated the program goes to the
next record. Since you cannot close rs.AddNew (at least from what I
understand) I must have it outside the loop. If no records with new PKs are
found the program ends. The problem then is that I cannot perform rs.Close
and I get an error message "memory could not be written." Is there a way
around this? Thank you.

Brent