Excel export to Access

[Jim Alexander]

While designing my service reports using Excel 2002, I didn't take into

consideration the fact that I would need to export data to an Access 2002

database in the future. Therefore, I've got cells at different

locations throughout the worksheet that contain information that I

need to export. All information regarding exporting data to Access

implies that one has to start out with a tabular type Excel worksheet

in order to facilitate an import. I've had success using a macro to

copy the affected cells to another spreadsheet and then importing from

that spreadsheet. Unfortunately I have about six hundred service

tickets, (one per worksheet, each one a separate file) and need to

come up with a scheme that will allow me to do this in a more

efficient manner. Any ideas would be appreciated.

 

[Jim]

Proper Prior Planning Prevents P*ss-Poor Performance.

 

[Justin]

A number of question first:

Have you used a file naming convention in the folder or
folders in which the files exist?

Does data that needs to amalgamated appear in the same
named worksheets and cells in eacxh of the workbooks?

If the answer is yes to these questions then maybe it is
easily achieved. If the answer to the second question is
no then it will be virtually impossible unless there is
some logic as to where the data is positioned. Being told
that planning ahead is the answer is all very well but it
does not solve the problem.

Let me know.

 

[Jim Alexander]

Understood, however, the world does change as well as ones needs. Too bad we
can't tell the future....

 

[Jim Alexander]

The answer is "Yes".

The files each have one worksheet each. The naming convention used for the
files are: YYYYMMDD_XXXX_XXXXXXXX, where the first series are date, the
second is the case number (unique), and the last part is the customer's
name. (Which varies in length. Example: St. Joseph's, or Memorial Hosp.)

There are roughly 15 cells in each of the worksheets that contain the needed
data. They are consistent throughout the whole scheme. I can tell you the
cell names if needed.

Thanks for the response.

Jim

 

[Dave Peterson]

Are the files all in the same folder? (If not, just run it multiple times and
copy|paste the results into a giant workbook later.)

Option Explicit
Option Base 0
Sub testme03()

Application.ScreenUpdating = False

Dim myFiles() As String
Dim iCtr As Long
Dim jCtr As Long
Dim myFile As String
Dim myInPath As String
Dim tempWkbk As Workbook
Dim testWks As Worksheet
Dim logWks As Worksheet
Dim oRow As Long
Dim myAddresses As Variant

myAddresses = Array("a1", "B9", "C12", "e14", "F17", "G92", _
"b13", "c22", "q7")

Set logWks = Workbooks.Add(1).Worksheets(1)
With logWks
.Name = "Log_" & Format(Date, "yyyymmdd_hhmmss")
.Range("a1:b1").Value _
= Array("WorkbookName", "Error")
.Range("c1").Resize(1, UBound(myAddresses) - LBound(myAddresses) +
1).Value _
= myAddresses
End With
oRow = 1

myInPath = "c:\my documents\excel\test"
If Right(myInPath, 1) <> "\" Then
myInPath = myInPath & "\"
End If

myFile = Dir(myInPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
iCtr = 0
Do While myFile <> ""
iCtr = iCtr + 1
ReDim Preserve myFiles(1 To iCtr)
myFiles(iCtr) = myFile
myFile = Dir()
Loop

If iCtr > 0 Then
For iCtr = LBound(myFiles) To UBound(myFiles)
If LCase(myFiles(iCtr)) Like "########_####_*.xls" Then
Application.StatusBar _
= "Processing: " & myFiles(iCtr) & " at: " & Now
oRow = oRow + 1
logWks.Cells(oRow, 1).Value = myFiles(iCtr)
Set tempWkbk = Nothing
On Error Resume Next
Application.EnableEvents = False
Set tempWkbk = Workbooks.Open(Filename:=myInPath &
myFiles(iCtr), _
ReadOnly:=True, UpdateLinks:=0)
Application.EnableEvents = True
On Error GoTo 0
If tempWkbk Is Nothing Then
'couldn't open it for some reason
logWks.Cells(oRow, "B").Value = "Error opening workbook"
Else
Set testWks = Nothing
On Error Resume Next
Set testWks = tempWkbk.Worksheets(1)
'use first worksheet?
'or
'Set testWks = tempWkbk.Worksheets("sheet1")
'if they have a common name
On Error GoTo 0
If testWks Is Nothing Then
logWks.Cells(oRow, "B").Value = "Missing sheet"
'do nothing
Else
With testWks
For jCtr = LBound(myAddresses) _
To UBound(myAddresses)
logWks.Cells(oRow, "C").Offset(0, jCtr).Value _
= testWks.Range(myAddresses(jCtr)).Value
Next jCtr
End With
End If
tempWkbk.Close savechanges:=False
End If
End If
Next iCtr
logWks.UsedRange.Columns.AutoFit
Else
logWks.Parent.Close savechanges:=False
End If

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

 

[Jim Alexander]

Wow! Thanks for the assistance. I'll let you know how it worked.