code to append from excel

[allyn44]

Hi---I have to import some data from excel into an Access table--the
code below is working ok but I would like to condense it by running a
loop. The number of records can vary from 1 to 30 in each excel
file--have tried to run a loop through the recs and it quits so I have
just repeated the code below 30 times--any suggestions on how to run a
loop instead and have it quit when it reaches the last line of the
excel file? This code is in an Excel macro

thanks
bob stafford
Sub AppendToAccess()

Dim TheDB As Database
Dim TheRecordset As Recordset

'Sets Access Image Database
Set TheDB = OpenDatabase("C:\ImageTest.mdb")
Set TheRecordset = TheDB.TableDefs("SkinImagedFields"). _
OpenRecordset(dbOpenDynaset)
With TheRecordset

'Checks for Nulls; If null, then Exits Sub. If not, then Appends
Record

If Range("A1") = "" Then
Exit Sub

Else
.AddNew
.Fields("LabNum") = Range("A1").Value
.Fields("BiopsyNum") = Range("B1").Value
.Fields("FieldNum") = Range("C1").Value
.Fields("PositiveNuclei") = Range("D1").Value
.Fields("NegativeNuclei") = Range("E1").Value
.Fields("NonNuclearArea") = Range("F1").Value
.Update
End If

If Range("A2") = "" Then
MsgBox "You Have Imported 1 Record", vbOKOnly, "Added Record
to Access"
Exit Sub
Else
.AddNew
.Fields("LabNum") = Range("A2").Value
.Fields("BiopsyNum") = Range("B2").Value
.Fields("FieldNum") = Range("C2").Value
.Fields("PositiveNuclei") = Range("D2").Value
.Fields("NegativeNuclei") = Range("E2").Value
.Fields("NonNuclearArea") = Range("F2").Value
.Update
End If
If Range("A3") = "" Then
MsgBox "You Have Imported 2 Record", vbOKOnly, "Added Record
to Access"
Exit Sub
Else
.AddNew
.Fields("LabNum") = Range("A3").Value
.Fields("BiopsyNum") = Range("B3").Value
.Fields("FieldNum") = Range("C3").Value
.Fields("PositiveNuclei") = Range("D3").Value
.Fields("NegativeNuclei") = Range("E3").Value
.Fields("NonNuclearArea") = Range("F3").Value
.Update
End If
repeated many times

[Jana]

Ally:

Try this instead. It allows the user to specify how many rows to
Append, but will exit out if it hits a blank field in column A before
it reaches that number. If you want to, you can just declare a value
for MyLastCell in your code that is always larger than the number of
rows that would be used in your spreadsheet. This would mean you can
take out the lines referenced under the section that gets the user
input and replace it with the following:
MyLastCell = CInt(30)

Otherwise, it should work as is (fixing any lines that wrapped when I
pasted in the post).

Sub AppendToAccess()

Dim TheDB As Database
Dim TheRecordset As Recordset
Dim MyCurrentCell, MyLastCell
Dim MyCount As Integer
Dim MyMsg As String

'Get number of rows from user--if no input, do nothing
MyLastCell = InputBox("What is the last row number to append?", "Enter
Number of Cells")
If MyLastCell = "" Then Exit Sub
MyLastCell = CInt(MyLastCell)

'Set cell references (Row #, Column #)
Set MyCurrentCell = ActiveSheet.Cells(1, 1) 'A1
Set MyLastCell = ActiveSheet.Cells(MyLastCell, 6) 'F30, if user
enters 30
X = 0

'Sets Access Image Database
Set TheDB = OpenDatabase("C:\ImageTest.mdb")
Set TheRecordset = TheDB.TableDefs("SkinImagedFields"). _
OpenRecordset(dbOpenDynaset)
With TheRecordset

'Checks for Nulls; If null, then Exits Loop. If not, then Appends
Record
Do Until MyCurrentCell.Row > MyLastCell.Row
If MyCurrentCell.Value = "" Then
Exit Do
Else
.AddNew
.Fields("LabNum") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column B
.Fields("BiopsyNum") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column C
.Fields("FieldNum") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column D
.Fields("PositiveNuclei") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column E
.Fields("NegativeNuclei") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column F
.Fields("NonNuclearArea") = MyCurrentCell.Value
.Update
End If
X = X + 1 'counter for number of records appended to Access
Set MyCurrentCell = ActiveSheet.Cells(X + 1, 1) 'Move to first
cell in next column
Loop
End With

'Create message for MsgBox
Select Case X
Case Is <= 0
MyMsg = "No Records Were Appended."
Case Is = 1
MyMsg = "You Have Imported 1 Record."
Case Else
MyMsg = "You Have Imported " & X & " Records."
End Select

'Display MsgBox
MsgBox MyMsg, vbOKOnly, "Append Results"
End Sub
I tested it beforehand and seems to do what you're requesting. Good
luck!

Jana

[Jana]

Bob:

Try this instead. It allows the user to input the desired number of
rows to append into Access for you, but will exit out as soon as it
reaches an empty cell in column A, even if it hasn't reached that
number yet. If you would prefer, you can replace the section that gets
the user input with a statement that just specifies a max number of
rows to iterate through. Just replace that section with the following
line:
MyLastCell = CInt(30)

This would set the maximum number of rows to 30. You can go a little
larger since it will stop as soon as it hits a blank cell in column A
anyway.

Here is the code, you'll probably have to clean up any word wrapping
that happened when I posted, but I tested it with a database and it
worked fine.

Sub AppendToAccess()

Dim TheDB As Database
Dim TheRecordset As Recordset
Dim MyCurrentCell, MyLastCell
Dim X As Integer
Dim MyMsg As String

'Get number of rows from user--if no input, do nothing
MyLastCell = InputBox("What is the last row number to append?", "Enter
Number of Cells")
If MyLastCell = "" Then Exit Sub
MyLastCell = CInt(MyLastCell)

'Set cell references (Row #, Column #)
Set MyCurrentCell = ActiveSheet.Cells(1, 1) 'A1
Set MyLastCell = ActiveSheet.Cells(MyLastCell, 6) 'F30, if user
enters 30
X = 0
'Sets Access Image Database
Set TheDB = OpenDatabase("C:\ImageTest.mdb")
Set TheRecordset = TheDB.TableDefs("SkinImagedFields"). _
OpenRecordset(dbOpenDynaset)
With TheRecordset

'Checks for Nulls; If null, then Exits Loop. If not, then Appends
Record
Do Until MyCurrentCell.Row > MyLastCell.Row
If MyCurrentCell.Value = "" Then
Exit Do
Else
.AddNew
.Fields("LabNum") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column B
.Fields("BiopsyNum") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column C
.Fields("FieldNum") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column D
.Fields("PositiveNuclei") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column E
.Fields("NegativeNuclei") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column F
.Fields("NonNuclearArea") = MyCurrentCell.Value
.Update
End If
X = X + 1 'counter for number of records appended to Access
Set MyCurrentCell = ActiveSheet.Cells(X + 1, 1) 'Move to first
cell in next column
Loop
End With

'Create message for MsgBox
Select Case X
Case Is <= 0
MyMsg = "No Records Were Appended."
Case Is = 1
MyMsg = "You Have Imported 1 Record."
Case Else
MyMsg = "You Have Imported " & X & " Records."
End Select

'Display MsgBox
MsgBox MyMsg, vbOKOnly, "Append Results"
End Sub

Good luck!
Jana

[allyn44]

Thanks--will try it and let you know how it worked out

Bob
On 24 Feb 2005 17:37:25 -0800, "Jana" <Ba********@gmail.com> wrote:

Ally:

Try this instead. It allows the user to specify how many rows to
Append, but will exit out if it hits a blank field in column A before
it reaches that number. If you want to, you can just declare a value
for MyLastCell in your code that is always larger than the number of
rows that would be used in your spreadsheet. This would mean you can
take out the lines referenced under the section that gets the user
input and replace it with the following:
MyLastCell = CInt(30)

Otherwise, it should work as is (fixing any lines that wrapped when I
pasted in the post).

Sub AppendToAccess()

Dim TheDB As Database
Dim TheRecordset As Recordset
Dim MyCurrentCell, MyLastCell
Dim MyCount As Integer
Dim MyMsg As String

'Get number of rows from user--if no input, do nothing
MyLastCell = InputBox("What is the last row number to append?", "Enter
Number of Cells")
If MyLastCell = "" Then Exit Sub
MyLastCell = CInt(MyLastCell)

'Set cell references (Row #, Column #)
Set MyCurrentCell = ActiveSheet.Cells(1, 1) 'A1
Set MyLastCell = ActiveSheet.Cells(MyLastCell, 6) 'F30, if user
enters 30
X = 0

'Sets Access Image Database
Set TheDB = OpenDatabase("C:\ImageTest.mdb")
Set TheRecordset = TheDB.TableDefs("SkinImagedFields"). _
OpenRecordset(dbOpenDynaset)
With TheRecordset

'Checks for Nulls; If null, then Exits Loop. If not, then Appends
Record
Do Until MyCurrentCell.Row > MyLastCell.Row
If MyCurrentCell.Value = "" Then
Exit Do
Else
.AddNew
.Fields("LabNum") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column B
.Fields("BiopsyNum") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column C
.Fields("FieldNum") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column D
.Fields("PositiveNuclei") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column E
.Fields("NegativeNuclei") = MyCurrentCell.Value
Set MyCurrentCell = MyCurrentCell.Offset(0, 1) 'Move to
column F
.Fields("NonNuclearArea") = MyCurrentCell.Value
.Update
End If
X = X + 1 'counter for number of records appended to Access
Set MyCurrentCell = ActiveSheet.Cells(X + 1, 1) 'Move to first
cell in next column
Loop
End With

'Create message for MsgBox
Select Case X
Case Is <= 0
MyMsg = "No Records Were Appended."
Case Is = 1
MyMsg = "You Have Imported 1 Record."
Case Else
MyMsg = "You Have Imported " & X & " Records."
End Select

'Display MsgBox
MsgBox MyMsg, vbOKOnly, "Append Results"
End Sub
I tested it beforehand and seems to do what you're requesting. Good
luck!

Jana

[Jana]

Bob:

How did that work out for you?

Just curious,
Jana

[allyn44]

On 9 Mar 2005 15:10:02 -0800, "Jana" <Ba********@gmail.com> wrote:

Bob:

How did that work out for you?

Just curious,
Jana

Hi--sorry to not get back sooner--it worked exactly as we needed it!!
Thanks very much! Just cannot seem to get my head around looping :(

[Jana]

Yay! Glad it worked out for you :)