how to insert workbook names and worksheet names to access columns

[Guest]

Dear All,

Please how can I copy or insert the filename (workbook) without the .xls
extension in the first column of the access table and the worksheet name
(worksheet tab) in the second column of an access table?

Please I am working on a cost accounting document of
a company. The workbook is named after the cost center name eg Sales and the
Worksheet is named after the general ledger code (GLCode eg EE00875). After
trasfering all worksheets of all workbooks into one access table using the
TransferSpreadsheet method (this is successful), I created two columns using
the RunSQL and ALTER TABLE statement (this also is successful). I now want
to fill
these two access columns with the workbooknames without the .xls extension
and the
worksheetnames in the access table. This does not work. I am using the INSERT
INTO-- VALUES statement. See the code below. Should I also try the UPDATE
statement.


Private Sub Command7_Click()
Dim xlApp As Excel.Application
Dim xlWS As Excel.Worksheet
Dim xlWB As Excel.Workbook
Dim i As Integer
Dim strFileName As String


Dim wkShName As String
Dim strFolderPath As String
Dim strPath As String
Dim strPathBrowser As String
Dim bookName As String
Dim strFileNameValue As String
Dim strFullPath As String
Dim j As Integer

Set xlApp = New Excel.Application
On Error Resume Next
strPath = "C:\Documents and Settings\a99858\My Documents\"
strFileName = Dir(strPath & "*.xls")

strFullPath = strPath & strFileName
Do While Len(strFileName) > 0


strFullPath = strPath & strFileName
strFileNameValue = strFileName

xlApp.Workbooks.Open (strFullPath)

For j = 1 To xlApp.Worksheets.count
Set xlWS = xlApp.ActiveWorkbook.Worksheets(j)
wkShName = xlWS.Name

DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", strFullPath, -1,
wkShName & "!A1:F8"

DoCmd.RunSQL "ALTER TABLE MultiSheet_Example ADD COLUMN CCCode CHAR, GCode
CHAR", -1
DoCmd.RunSQL "INSERT INTO MultiSheet_Example (CCCode ,GCode) VALUES (&
strFileNameValue, & wkShName)"

Next j

strFileName = Dir()
Loop

End Sub


Please any idea on how to insert the workbooknames and corresponding
worksheet names into the access columns created?

Thanks
Gokop

 

[Gary Walter]

Please how can I copy or insert the filename (workbook) without the .xls
extension in the first column of the access table and the worksheet name
(worksheet tab) in the second column of an access table?

Please I am working on a cost accounting document of
a company. The workbook is named after the cost center name eg Sales and
the
Worksheet is named after the general ledger code (GLCode eg EE00875).
After
trasfering all worksheets of all workbooks into one access table using the
TransferSpreadsheet method (this is successful), I created two columns
using
the RunSQL and ALTER TABLE statement (this also is successful). I now want
to fill
these two access columns with the workbooknames without the .xls extension
and the
worksheetnames in the access table. This does not work. I am using the
INSERT
INTO-- VALUES statement. See the code below. Should I also try the UPDATE
statement.


Private Sub Command7_Click()
Dim xlApp As Excel.Application
Dim xlWS As Excel.Worksheet
Dim xlWB As Excel.Workbook
Dim i As Integer
Dim strFileName As String


Dim wkShName As String
Dim strFolderPath As String
Dim strPath As String
Dim strPathBrowser As String
Dim bookName As String
Dim strFileNameValue As String
Dim strFullPath As String
Dim j As Integer

Set xlApp = New Excel.Application
On Error Resume Next
strPath = "C:\Documents and Settings\a99858\My Documents\"
strFileName = Dir(strPath & "*.xls")

strFullPath = strPath & strFileName
Do While Len(strFileName) > 0


strFullPath = strPath & strFileName
strFileNameValue = strFileName

xlApp.Workbooks.Open (strFullPath)

For j = 1 To xlApp.Worksheets.count
Set xlWS = xlApp.ActiveWorkbook.Worksheets(j)
wkShName = xlWS.Name

DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example",
strFullPath, -1,
wkShName & "!A1:F8"

DoCmd.RunSQL "ALTER TABLE MultiSheet_Example ADD COLUMN CCCode CHAR,
GCode
CHAR", -1
DoCmd.RunSQL "INSERT INTO MultiSheet_Example (CCCode ,GCode) VALUES (&
strFileNameValue, & wkShName)"

Next j

strFileName = Dir()
Loop

End Sub


Please any idea on how to insert the workbooknames and corresponding
worksheet names into the access columns created?

Hi Gokop,

It has always fared me well to use a var (say "strSQL")
to write out SQL in code before executing it.

After the assignment stmt you can always

Debug.Print strSQL

to get the SQL string you really built vs. what you hoped to make
in the Immediate Window.

Or...if you don't want to wait for the code to run (to debug print),
then copy your

strSQL = "..." code line(s)

straight to the Immediate Window,
hit <enter> to assign string to var strSQL,
then "print it out"

?strSQL

So..if you had written code as

strSQL="INSERT INTO MultiSheet_Example (CCCode ,GCode) VALUES (&
strFileNameValue, & wkShName)"

copied that to clipboard,
paste into Immediate Window,

then asked for its value back

?strSQL

it might be evident to you what you have done wrong...

My guess is you wanted something like:

strSQL="INSERT INTO MultiSheet_Example (CCCode ,GCode) " _
& "VALUES ('" & strFileNameValue & "','" & wkShName & "')"

good luck,

gary

 

[Gary Walter]

So..if you had written code as

strSQL="INSERT INTO MultiSheet_Example (CCCode ,GCode) VALUES (&
strFileNameValue, & wkShName)"

copied that to clipboard,
paste into Immediate Window,

then asked for its value back

?strSQL

it might be evident to you what you have done wrong...

actually...

in similar case, you might need to also assign some temp value
to your 2 modules vars in the Immediate Window

so your Immediate Window might look like:

strFileName="C:\somefile.xls"
wkShName="wksht1"
strSQL="INSERT INTO MultiSheet_Example (CCCode ,GCode) VALUES (&
strFileNameValue, & wkShName)"
?strSQL

 

[Gary Walter]

{what I wish I had said...}

actually...

When you have module vars included in the
construction of your SQL string,
you would need to also assign some temp value
to those vars in the Immediate Window

so your Immediate Window might look like:

strFileNameValue="C:\somefile.xls"
wkShName="wksht1"
strSQL="INSERT INTO MultiSheet_Example (CCCode ,GCode) " _
& "VALUES ('" & strFileNameValue & "','" & wkShName & "')"
?strSQL
INSERT INTO MultiSheet_Example (CCCode ,GCode) VALUES
('C:\somefile.xls','wksht1')

good luck,

gary

 

[Gary Walter]

{what I wish I had said...}

actually...

When you have module vars included in the
construction of your SQL string,
you would need to also assign some temp value
to those vars in the Immediate Window

so your Immediate Window might look like:

strFileNameValue="C:\somefile.xls"
wkShName="wksht1"
strSQL="INSERT INTO MultiSheet_Example (CCCode ,GCode) " _
& "VALUES ('" & strFileNameValue & "','" & wkShName & "')"
?strSQL
INSERT INTO MultiSheet_Example (CCCode ,GCode) VALUES
('C:\somefile.xls','wksht1')

Of course I missed the part where you really
wanted to UPDATE, not INSERT

For j = 1 To xlApp.Worksheets.count
Set xlWS = xlApp.ActiveWorkbook.Worksheets(j)
wkShName = xlWS.Name

DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", strFullPath, -1,
wkShName & "!A1:F8"

'why is this *within* loop?
DoCmd.RunSQL "ALTER TABLE MultiSheet_Example ADD COLUMN CCCode CHAR, GCode
CHAR", -1

'Dim strSQL As String
strSQL = "UPDATE MultiSheet_Example " _
& "SET CCCode = '" & strFileName & "', GCode ='" & wkShName & "' " _
& "WHERE CCCode IS NULL;"
CurrentDb.Execute strSQL, dbFailOnError

Next j

 

[Guest]

Dear Gary,

Thank you very very very .......................... MUCH. The UPDATE
statement did the magic. Thanks so much GARY!!!

Your question as to why the ALTER TABLE statement is within the loop. This
is because it has to create two columns after it has transfered the data from
excel to access. Although it looks as if it may create two each time it
loops, this does not occur because the names of the columns are the same. Yes
agreed it is not a good idea to put it within the loop.

Thanks again.
Gokop

 

[Guest]

Dear Gary,

Thank you very much again. Please I want to replace
strPath = "C:\Documents and Settings\a99858\AirTravelBudget\" with

strPath = BrowseFolder("Select Folder") to make it generic. The problem is
that it does not give any error, but nothing happens, is no folder is
activated sort of when I choose a folder.

See the codes below:
'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function
'*********** Code End *****************

Private Sub Command2_Click()
'Dim strSheet() As String
'xlsSheetLoop (strSheet())
Dim xlApp As Excel.Application
Dim xlWS As Excel.Worksheet
Dim xlWB As Excel.Workbook
Dim i As Integer
Dim strFileName As String
Dim strOpenFile As String
Dim strNameOnly As String

Dim wkShName As String
Dim objFSO As Object
Dim objFile As Object
Dim strFolderPath As String
Dim strPath As String
Dim strPathBrowser As String
Dim bookName As String
'Dim fieldValue As Field
Dim rangeValue As Range
Dim strFileNameValue As String
Dim workBookName As Names
Dim strFullPath As String
Dim j As Integer
Dim strActiveBook As Object
Dim strDefaultPath As String

Dim strSQL As String

Set xlApp = New Excel.Application
On Error Resume Next
strDefaultPath = BrowseFolder("Select Folder")
strPath = strDefaultPath
If strPath = vbNullString Then
MsgBox "No Folder Selected"
Else
strFileName = Dir(strPath & "*.xls")
strFullPath = strPath & strFileName
Do While Len(strFileName) > 0
strFullPath = strPath & strFileName
strFileNameValue = strFileName
strNameOnly = Left(strFileName, Len(strFileName) - 4)
xlApp.Workbooks.Open (strFullPath)
xlApp.Workbooks.Open (strFullPath)

For j = 1 To xlApp.Worksheets.Count

Set xlWS = xlApp.ActiveWorkbook.Worksheets(j)
wkShName = xlWS.Name

DoCmd.TransferSpreadsheet acImport, , "AirTravel_Table", strFullPath, -1,
wkShName & "!A15:O1016"


DoCmd.RunSQL "ALTER TABLE AirTravel_Table ADD COLUMN CostCentreCode CHAR,
GLCode CHAR", -1

strSQL = "UPDATE AirTravel_Table SET CostCentreCode = '" & strNameOnly & "',
GLCode = '" & wkShName & "' WHERE CostCentreCode IS NULL"
CurrentDb.Execute strSQL, dbFailOnError
Next j

strFileName = Dir()
Loop
End If
End Sub

Any help is appreciated
Regards
Gokop

 

[Guest]

Dear Gary,

Thanks for your help. I now want to replace the:

strPath="C:\Documents and Settings\a99858\My Documents\ with a generic:

strPath=BrowseFolder("Select Folder")
but when I browsed and selected a folder and clicking ok, nothing happens.
How can I activate the BrowseFolder Function. See my code:

Dear Gary,

Thank you very very very .......................... MUCH. The UPDATE
statement did the magic. Thanks so much GARY!!!

Your question as to why the ALTER TABLE statement is within the loop. This
is because it has to create two columns after it has transfered the data from
excel to access. Although it looks as if it may create two each time it
loops, this does not occur because the names of the columns are the same. Yes
agreed it is not a good idea to put it within the loop.

Thanks again.
Gokop

Kind regards
Gokop

 

[Gary Walter]

"gokop"wrote:

Thanks for your help. I now want to replace the:

strPath="C:\Documents and Settings\a99858\My Documents\ with a generic:

strPath=BrowseFolder("Select Folder")
but when I browsed and selected a folder and clicking ok, nothing happens.
How can I activate the BrowseFolder Function. See my code:

Hi Gokop,

Mr. Kreft (along with many MVP's) has provided some
very useful code on the web. The BrowseFolder might
be something you will use again and again in your projects.

It deserves to be in its own code module so somewhere
down the road you could just import it into a new project.

In the Database Window, select Modules in the Object list
on the left, and click on "New Module" in window menu.

Start by adding line "Option Explicit"
then move Kreft's code here so your module looks like:

Option Compare Database
Option Explicit
'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function
'*********** Code End *****************

Save the module (say as "modKreftBrowseFolder")

From the top menu, click on DeBug/Compile
to make sure copy/paste went okay.

Now, in Immediate Window, let's test it...

?BrowseFolder("test")
C:\Documents and Settings\Gary.Walter\My Documents

I chose my "My Documents" folder.

Notice how we don't get an ending "\"

Now...let's test code like you were using...

strPath=BrowseFolder("test")
?strPath
C:\Documents and Settings\Gary.Walter\My Documents
strFileName=Dir(strPath & "*.xls")
?strFileName


The strFileName came back as "nothing"

So...that ending "\" must be important!

strFileName=Dir(strPath & "\*.xls")
?strFileName
Book1.xls

Success!

or, another test in Immediate Window:

strPath=BrowseFolder("test") & "\"
?strPath
C:\Documents and Settings\Gary.Walter\My Documents\
strFileName=Dir(strPath & "*.xls")
?strFileName
Book1.xls

Another success!

hopefully you will see what you need to do now...

good luck,

gary

 

[Guest]

Dear Gary,

Please I am sorry for these questions. I am using Access and it does not
give me the 'imports' option to import the modKreftBrowseFolder I created.
What object should I check in the reference libray?

 

[Gary Walter]

What version of Access?

I have not used 2007 yet, but in other
versions...

in top menu

File/Get External Data/Import...

one would choose the mdb
that the module is in, you then get a
window with tabs which one is Modules.
Choose this tab, then check box by
the module you want to import.

 

[Gary Walter]

Of course, if the module is already
in the mdb you are working on, you
do not need to import it again!

 

[Guest]

Dear gary,

Thanks very much. It works perfectly well now. Thanks a million again!!
Gokop