how can I add 2 columns to excel data and populate it

[gglgokop1704]

Dear All,

Please how can I add two extra fields to existing excell whorksheet and populate them with the workbook name and worksheet name respectively (programmatically).

I have several excel files that contain sevel worksheets. I want to transfer the worksheets from each work book to access and craete two columns which will be populated with the workbook names (Cost Centers) and worksheet names (General Ledgers). I have succeeded in trasfering the data and creating the two columns in access using TransferSpreadsheet method and ALTER table statement. The problem is that I could not populate the two columns after transfering to access using INSERT INTO or UPDATE statements. I am thinking if it is wiser to create the 2 columns in excel and populate them first before importing them to access.

Please any idea?

See my code below:

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

Any help will be appreciated
Gokop

 

[SkipVought]

Hi,

Give this a try...

    Dim xlWB As Workbook, xlWS As Worksheet
    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
        
        Set xlWB = xlApp.Workbooks.Open(strFullPath)
        
        For Each xlWS In xlWB.Worksheets
            With xlWS
                .Range(.Cells(2, .Columns.Count + 1), .Cells(.Rows.Count, .Columns.Count + 1)).Value = xlWB.Name
                .Range(.Cells(2, .Columns.Count + 2), .Cells(.Rows.Count, .Columns.Count + 2)).Value = xlWS.Name
                DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", strFullPath, -1, .Name & "!" & .[A1].CurrentRegion.Address
                
                DoCmd.RunSQL "ALTER TABLE MultiSheet_Example ADD COLUMN CCCode CHAR,  GCode CHAR ", -1
                DoCmd.RunSQL "INSERT INTO MultiSheet_Example (CCCode ,GCode) VALUES (" & strFileNameValue & "," & .Name & ")"
            End With
        Next
        
        strFileName = Dir()
    Loop
    
    Set xlWB = Nothing
    Set xlWS = Nothing

Skip,

_{When a wee mystic is on the loose..
It's a Small Medium at Large!}

 

[gglgokop1704]

Dear Skip,

Thanks very much. It looks good, I will try running it and let you know the outcome.

Kind regards
Gokop

 

[gglgokop1704]

Dear Skip,

Thanks a lot. When I ran the code, it is asking me for inputs for the workbooks and worksheets parameters. It is not creating the MultiSheet_Example access table in access. The former code was trasfering the workbooks and worksheets and creating two columns. The problem was I could not populate the two columns with the workbook names and corresponding workshheet names respectively. Please any idea why is not showing the MultiSheet_Example table and why is asking for input parameters for the workbooks and worksheets?

Any help is appreciated.

Kind regards
Gokop

 

[SkipVought]

"... it is asking me for inputs for the workbooks and worksheets parameters..."

On what statement? I suspect it is these two lines. You will have to figgure out where the variables go.
]code]
DoCmd.RunSQL "ALTER TABLE MultiSheet_Example ADD COLUMN CCCode CHAR, GCode CHAR ", -1
DoCmd.RunSQL "INSERT INTO MultiSheet_Example (CCCode ,GCode) VALUES (" & strFileNameValue & "," & .Name & ")"
[/code]

Please post all your code.

Skip,

_{When a wee mystic is on the loose..
It's a Small Medium at Large!}

 

[gglgokop1704]

Dear Skip,

Thanks. I have figured it out. I used UPDATE statement instead of INSERT INTO. Thanks again.

Regards
Gokop

 

[gglgokop1704]

Dear Skip,

Please how can I use the BrowseFolder function to get my path to the file? I used the codes sent to me and it shows the folder path but when I click OK after choosing the folder, nothing happens. This is the code:

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

Dim xlWB As Workbook, xlWS As Worksheet
Set xlApp = New Excel.Application
On Error Resume Next
strPath=BrowseFolder("Select Folder")
strFileName = Dir(strPath & "*.xls")

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


strFullPath = strPath & strFileName
strFileNameValue = strFileName

Set xlWB = xlApp.Workbooks.Open(strFullPath)

For Each xlWS In xlWB.Worksheets
With xlWS
.Range(.Cells(2, .Columns.Count + 1), .Cells(.Rows.Count, .Columns.Count + 1)).Value = xlWB.Name
.Range(.Cells(2, .Columns.Count + 2), .Cells(.Rows.Count, .Columns.Count + 2)).Value = xlWS.Name
DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", strFullPath, -1, .Name & "!" & .[A1].CurrentRegion.Address

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

strFileName = Dir()
Loop

Set xlWB = Nothing
Set xlWS = Nothing


'************** 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

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 *****************

Any help is appreciated

 

[SkipVought]

Put a break in your code and check the value in your file name...

...
    strPath=BrowseFolder("Select Folder")
    strFileName = Dir(strPath & "*.xls")
...

strPath only have a PATH - no file names

Skip,

_{When a group touring the Crest Toothpaste factory got caught in a large cooler, headlines read...
Tooth Company Freeze a Crowd! and
Many are Cold, but Few are Frozen!}

 

[gglgokop1704]

Dear Skip,

Thanks for your reply. It is true that
strPath=BrowseFolder("Select Folder") shows only the path and not the file name.

In my code I used

strFileName = Dir(strPath & "*.xls")
strFullPath=strPath & strFILEname

to get both the path and file name. It works when I used "C:\Documents and settings\a99858\My Documents\" but fails to

Regards
Gokop

 

[gglgokop1704]

Please when declarations like these occur, what libraries am I going to check for them to work:

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


I guess my code is not activating the folder browsed. I am not sure.

Regards
Gokop

 

[SkipVought]

I get a path

    strPath=BrowseFolder("Select Folder")

Do you?

Skip,

_{When a group touring the Crest Toothpaste factory got caught in a large cooler, headlines read...
Tooth Company Freeze a Crowd! and
Many are Cold, but Few are Frozen!}

 

[gglgokop1704]

Yes I got path with
strPath=BrowseFolder("Select Folder")

But when I choose a folder it does not transfer my Worksheets to Access table. The code is to transfer workbooks and worksheets using TransferSpreadSheet method. It works find when I used a static folder path eg
strPath = "C:\Documents and Settings\My Documents\", it trnasfers my workbooks and worksheets well,

But when I used

strPath=BrowseFolder("Select Folder")

and select the same "C:\Documents and Settings\My Documents\"

it does not transfer the worksheets. Nothing happens.

Any help to look at the parameters passed is appreciated
Gokop

 

[SkipVought]

Use debug and step thru your code, looking at key values.

Skip,

_{When a group touring the Crest Toothpaste factory got caught in a large cooler, headlines read...
Tooth Company Freeze a Crowd! and
Many are Cold, but Few are Frozen!}