MS Access

  • Thread starter Thread starter asxastro
  • Start date Start date
A

asxastro

Is this possible in MS Access VBA.

In MS Access have a table which contains 4 columns.

Column 1 contains records relating to the path of MS Excel File.

E.g. c:\\my_file\MS Excel\workbook1.xls

Column 2 contains records relating to the workbook name.

E.g. Sheet1

Column 3 contains records relating the one 'Column' letter in the
above MS excel workbook.

E.g. F

Column 4 contains records relating the another 'Column' letter in the
above MS excel workbook.

E.g. AB


A records layout will look like this in MS Access:

Path |
Worksheet_Name | Column1 | Column2
---------------------------------------------------------------------------------------------------------------------------------
c:\\my_file\MS Excel\workbook1.xls | Sheet1
| F | AB
c:\\my_file\MS Excel\workbook2.xls | Sheet23
| H | Z


My main question is : Can one build a macro which will go through the
above table records.

1st: Identify if path is valid.
2nd: Open the read only MS workbook.
3rd: Identify if worksheet is valid.
4th: Go to the specified Worksheet.
5th: Identify if column1 is unhidden.
6th: Copy the record contents in Column1
7th: Paste in a MS Access table call 'tbl_Holding' in column name
"Column1_Rlts".
8th: Identify if column1 is unhidden.
9th: Copy the record contents in Column2
10th: Paste in a MS Access table call 'tbl_Holding' in column name
"Column2_Rlts".
11th Remove blank records from the 'tbl_Holding' table in MS Access.
12th: Closed the MS workbook.
13th Loop points 1- 11 again until all records have gone through in
the table.

Final table would look like this:

Path |
Worksheet_Name | Column1_Rlts | Column2_Rlts
------------------------------------------------------------------------------------------------------------------------------------------------
c:\\my_file\MS Excel\workbook1.xls | Sheet1
| AAAAA | BBBB16
c:\\my_file\MS Excel\workbook1.xls | Sheet1
| ATAAD | BBBB12
c:\\my_file\MS Excel\workbook1.xls | Sheet1
| ASAAD | BBBV12
c:\\my_file\MS Excel\workbook2.xls | Sheet23
| DDDDA | ZSSSSS
c:\\my_file\MS Excel\workbook2.xls | Sheet23
| DDDDA | ZSSSSS
c:\\my_file\MS Excel\workbook2.xls | Sheet23
| DDDDA | ZSSSSS
......................

Many thanks in advance.... Apreciate any tip or links to help me with
this quest.

Kind regards.
 
Is this possible in MS Access VBA.

In MS Access have a table which contains 4 columns.

Column 1 contains records relating to the path of MS Excel File.

E.g. c:\\my_file\MS Excel\workbook1.xls

Column 2 contains records relating to the workbook name.

E.g. Sheet1

Column 3 contains records relating the one 'Column' letter in the
above MS excel workbook.

E.g.  F

Column 4 contains records relating the another 'Column' letter in the
above MS excel workbook.

E.g. AB

A records layout will look like this in MS Access:

Path                                                    |
Worksheet_Name   |   Column1    |   Column2
---------------------------------------------------------------------------­------------------------------------------------------
c:\\my_file\MS Excel\workbook1.xls       |   Sheet1
|    F             |   AB
c:\\my_file\MS Excel\workbook2.xls       |   Sheet23
|    H             |   Z

My main question is : Can one build a macro which will go through the
above table records.

1st: Identify if path is valid.
2nd: Open the read only MS workbook.
3rd: Identify if worksheet is valid.
4th: Go to the specified Worksheet.
5th: Identify if column1 is unhidden.
6th: Copy the record contents in Column1
7th: Paste in a MS Access table call 'tbl_Holding' in column name
"Column1_Rlts".
8th: Identify if column1 is unhidden.
9th: Copy the record contents in Column2
10th: Paste in a MS Access table call 'tbl_Holding' in column name
"Column2_Rlts".
11th Remove blank records from the  'tbl_Holding' table in MS Access.
12th: Closed the MS workbook.
13th  Loop points 1- 11 again until all records have gone through in
the table.

Final table would look like this:

Path                                                    |
Worksheet_Name   |   Column1_Rlts    |   Column2_Rlts
---------------------------------------------------------------------------­---------------------------------------------------------------------
c:\\my_file\MS Excel\workbook1.xls       |   Sheet1
|    AAAAA            |    BBBB16
c:\\my_file\MS Excel\workbook1.xls       |   Sheet1
|    ATAAD            |   BBBB12
c:\\my_file\MS Excel\workbook1.xls       |   Sheet1
|    ASAAD            |    BBBV12
c:\\my_file\MS Excel\workbook2.xls       |   Sheet23
|    DDDDA             |   ZSSSSS
c:\\my_file\MS Excel\workbook2.xls       |   Sheet23
|    DDDDA             |   ZSSSSS
c:\\my_file\MS Excel\workbook2.xls       |   Sheet23
|    DDDDA             |   ZSSSSS
.....................

Many thanks in advance.... Apreciate any tip or links to help me with
this quest.

Kind regards.
Click to expand...

Hi

I have a start for you below. Note that it is *far* from the most
efficient way of doing things, but should be fairly easy to follow. I
have not put any form of error trapping or similar in there, you would
be well advised to do so given you are opening up Excel objects and
workbooks etc, if the code throws an error you will want to trap it
and jump to some nice exit code so you can close down these objects.

I did not address the 5th or 8th item, as you dont say what the issue
is with hidden columns, you can add functionality there as you see
fit.


You will need to paste the code into a new module in Access, and then
turn on 2 references. To do this open your module in VB, and then go:
Tools-->References
and scroll down and add a tick to the following
Microsoft DAO 3.6 Object Library (if you have a slightly different
number thats OK)
Microsoft Excel 10.0 Object Library (ditto)


HTH
Andy C




Option Explicit
Option Compare Database

Public Function WorksheetExists(ByVal wb As Excel.Workbook, ByVal
WorksheetName As String) As Boolean

On Error Resume Next
WorksheetExists = (wb.Sheets(WorksheetName).Name <> "")
On Error GoTo 0

End Function

Sub test()

Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim bContinue As Boolean
Dim fs As Object
Dim myExcelApp As Excel.Application
Dim wb As Excel.Workbook
Dim strFileName As String
Dim strWorksheetName As String
Dim strColumn_1 As String
Dim strColumn_2 As String
Dim i As Integer
Dim iRowEnd As Integer
Dim strSQL As String

'Create a fso, this will be used to check if the excel file exists
Set fs = CreateObject("Scripting.FileSystemObject")

'Open up an excel app
Set myExcelApp = New Excel.Application

' Open the tbl_excel_input table
Set db = CurrentDb
Set rst = db.OpenRecordset("tbl_excel_input")


'Loop over each record in tbl_excel_input...
While Not rst.EOF

'Read this record
strFileName = rst("filename")
strWorksheetName = rst("worksheetname")
strColumn_1 = rst("column_1")
strColumn_2 = rst("column_2")


'Initially assume everything is OK with this excel file...
bContinue = True

'Check: does this excel file exist?
bContinue = fs.FileExists(rst("filename"))
If (bContinue = False) Then
'POSSIBLY DO SOMETHING TO INDICATE THIS EXCEL FILE DOES NOT
EXIST
Else

'Excel file exists, open it
Set wb = myExcelApp.Workbooks.Open(Filename:=strFileName,
ReadOnly:=True)

'Check: does this worksheet exist?
bContinue = WorksheetExists(wb, strWorksheetName)
If (bContinue = False) Then
'POSSIBLY DO SOMETHING TO INDICATE THIS SHEET DOES NOT
EXIST
Else

'NOT DONE - IDENTIFY IF COLUMN1 OR COLUMN2 IS HIDDEN. NOT
SURE WHAT YOU WANTED TO HAPPEN IN THESE CASES.

'Sheet exists. Copy the data
'HOW TO BEST DO THIS CAN DEPEND ON YOUR DATA. MADE A VERY
CRASS METHOD OF FINDING THE LAST ROW
'THAT CONTAINS DATA

'Goto the bottom of column 1, then <ctrl-end> to get to
the last row of data in column 1
wb.Sheets(strWorksheetName).Activate
wb.Sheets(strWorksheetName).Range(strColumn_1 &
"65500").Activate
myExcelApp.ActiveCell.End(xlUp).Activate
iRowEnd = myExcelApp.ActiveCell.Row

'Do the same for column 2
wb.Sheets(strWorksheetName).Range(strColumn_2 &
"65500").Activate
myExcelApp.ActiveCell.End(xlUp).Activate
If (myExcelApp.ActiveCell.Row > iRowEnd) Then
iRowEnd = myExcelApp.ActiveCell.Row
End If

'Starting in the first cell of each column, walk down and
copy the data from the Excel column
'into an Access table.
'Insert the data one at a time using an SQL statement
'THIS IS INEFFICIENT, THERE ARE FASTER WAYS TO ADD THE
DATA INTO THE TABLE
For i = 1 To iRowEnd

strSQL = "INSERT INTO tbl_Holding (Worksheet_Name,
Column1_Rlts, Column2_Rlts) " & _
"VALUES (" & _
"""" & strFileName & "!" & strWorksheetName &
""", " & _
"""" &
Trim(wb.Sheets(strWorksheetName).Range(strColumn_1 & i).Value) & """,
" & _
"""" &
Trim(wb.Sheets(strWorksheetName).Range(strColumn_2 & i).Value) & """)"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True

Next i


End If

End If


'Move to the next record in tbl_excel_input
rst.MoveNext

Wend


'Delete all records in tbl_Holding where the data was blank
strSQL = "DELETE FROM tbl_Holding WHERE (Column1_Rlts = """") AND
(Column2_Rlts = """")"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True


'Clean up
rst.Close
db.Close
myExcelApp.Quit
Set myExcelApp = Nothing
Set db = Nothing


End Sub
 
Hi

I have a start for you below.  Note that it is *far* from the most
efficient way of doing things, but should be fairly easy to follow.  I
have not put any form of error trapping or similar in there, you would
be well advised to do so given you are opening up Excel objects and
workbooks etc, if the code throws an error you will want to trap it
and jump to some nice exit code so you can close down these objects.

I did not address the 5th or 8th item, as you dont say what the issue
is with hidden columns, you can add functionality there as you see
fit.

You will need to paste the code into a new module in Access, and then
turn on 2 references.  To do this open your module in VB, and then go:
Tools-->References
and scroll down and add a tick to the following
  Microsoft DAO 3.6 Object Library (if you have a slightly different
number thats OK)
  Microsoft Excel 10.0 Object Library (ditto)

HTH
Andy C

Option Explicit
Option Compare Database

Public Function WorksheetExists(ByVal wb As Excel.Workbook, ByVal
WorksheetName As String) As Boolean

On Error Resume Next
WorksheetExists = (wb.Sheets(WorksheetName).Name <> "")
On Error GoTo 0

End Function

Sub test()

Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim bContinue As Boolean
Dim fs As Object
Dim myExcelApp As Excel.Application
Dim wb As Excel.Workbook
Dim strFileName As String
Dim strWorksheetName As String
Dim strColumn_1 As String
Dim strColumn_2 As String
Dim i As Integer
Dim iRowEnd As Integer
Dim strSQL As String

'Create a fso, this will be used to check if the excel file exists
Set fs = CreateObject("Scripting.FileSystemObject")

'Open up an excel app
Set myExcelApp = New Excel.Application

' Open the tbl_excel_input table
Set db = CurrentDb
Set rst = db.OpenRecordset("tbl_excel_input")

'Loop over each record in tbl_excel_input...
While Not rst.EOF

    'Read this record
    strFileName = rst("filename")
    strWorksheetName = rst("worksheetname")
    strColumn_1 = rst("column_1")
    strColumn_2 = rst("column_2")

    'Initially assume everything is OK with this excel file...
    bContinue = True

    'Check: does this excel file exist?
    bContinue = fs.FileExists(rst("filename"))
    If (bContinue = False) Then
        'POSSIBLY DO SOMETHING TO INDICATE THIS EXCEL FILE DOES NOT
EXIST
    Else

        'Excel file exists, open it
        Set wb = myExcelApp.Workbooks.Open(Filename:=strFileName,
ReadOnly:=True)

        'Check: does this worksheet exist?
        bContinue = WorksheetExists(wb, strWorksheetName)
        If (bContinue = False) Then
            'POSSIBLY DO SOMETHING TO INDICATE THIS SHEET DOES NOT
EXIST
        Else

            'NOT DONE - IDENTIFY IF COLUMN1 OR COLUMN2 IS HIDDEN.  NOT
SURE WHAT YOU WANTED TO HAPPEN IN THESE CASES.

            'Sheet exists.  Copy the data
            'HOW TO BEST DO THIS CAN DEPEND ON YOUR DATA.  MADE A VERY
CRASS METHOD OF FINDING THE LAST ROW
            'THAT CONTAINS DATA

            'Goto the bottom of column 1, then <ctrl-end> to get to
the last row of data in column 1
            wb.Sheets(strWorksheetName).Activate
            wb.Sheets(strWorksheetName).Range(strColumn_1 &
"65500").Activate
            myExcelApp.ActiveCell.End(xlUp).Activate
            iRowEnd = myExcelApp.ActiveCell.Row

            'Do the same for column 2
            wb.Sheets(strWorksheetName).Range(strColumn_2 &
"65500").Activate
            myExcelApp.ActiveCell.End(xlUp).Activate
            If (myExcelApp.ActiveCell.Row > iRowEnd) Then
                iRowEnd = myExcelApp.ActiveCell.Row
            End If

            'Starting in the first cell of each column, walk down and
copy the data from the Excel column
            'into an Access table.
            'Insert the data one at a time using an SQL statement
            'THIS IS INEFFICIENT, THERE ARE FASTER WAYS TO ADD THE
DATA INTO THE TABLE
            For i = 1 To iRowEnd

                strSQL = "INSERT INTO tbl_Holding (Worksheet_Name,
Column1_Rlts, Column2_Rlts) " & _
                        "VALUES (" & _
                        """" & strFileName & "!" & strWorksheetName &
""", " & _
                        """" &
Trim(wb.Sheets(strWorksheetName).Range(strColumn_1 & i).Value) & """,
" & _
                        """" &
Trim(wb.Sheets(strWorksheetName).Range(strColumn_2 & i).Value) & """)"
                DoCmd.SetWarnings False
                DoCmd.RunSQL strSQL
                DoCmd.SetWarnings True

            Next i

        End If

    End If

    'Move to the next record in tbl_excel_input
    rst.MoveNext

Wend

'Delete all records in tbl_Holding where the data was blank
strSQL = "DELETE FROM tbl_Holding WHERE (Column1_Rlts = """") AND
(Column2_Rlts = """")"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True

'Clean up
rst.Close
db.Close
myExcelApp.Quit
Set myExcelApp = Nothing
Set db = Nothing

End Sub- Hide quoted text -

- Show quoted text -
Click to expand...


Andy C,

Many thanks for replying.

I'm having problems testing the code you've created, partly the SQL
statements are throwing out VB message exceptions when the macro is
run.

Please could you send me the sample MS Access database along with code
to my hotmail account please.

My hotmail account is: (e-mail address removed)


Many Thanks.

Bretta
 
Andy C,

Many thanks for replying.

I'm having problems testing the code you've created, partly the SQL
statements are throwing out VB message exceptions when the macro is
run.

Please could you send me the sample MS Access database along with code
to my hotmail account please.

My hotmail account is:  (e-mail address removed)

Many Thanks.

Bretta- Hide quoted text -

- Show quoted text -
Click to expand...

My hotmail account is: bbcdancer At hotmail.co.uk
 
My hotmail account is:  bbcdancer   At   hotmail.co.uk- Hide quotedtext -

- Show quoted text -
Click to expand...

It is also possible (probable?) that your spreadsheets are a little
more complicated, or have something in there which is causing my
simple sample Access code headaches. This wouldn't surprise me what-
so-ever.

Everything is fixable though, its just a matter of figuring out what
the problem is and taking it from there.

Perhaps start with the sample spreadsheets I sent you and slowly get
bits of your data into them. See if something falls over that's
obvious. Otherwise step through the code on one of the times it fails
and look at the strSQL statement (google 'immediate window access' for
help on how to see the value of a long string variable) and there
might be an obvious issue.

For example you can take the strSQL statement and paste it into a
reqular sql query and try to see if you can figure out what is wrong
with it.

For example things like extra " characters can cause sql headaches
(fixable headaches)


Anyway, the point here is that the sample code might be your problem
because it was very simplistic and not set up to deal with any
specific data issues. Once you know what issues to look for you can
start updating the code to deal with these.

Cheers
Andy C
 
Back
Top