Link to home
Start Free TrialLog in
Avatar of flfmmqp
flfmmqp

asked on

Access 2010

So I am opening up some excel files and copying the data into my access database.  The problem I think lies in after I have copied over the data and run a couple of quieries from Access to import it then it seems like I have lost my connection to the excel file.  What am I doing wrong?  I can't seem to close these excel files.  


Dim objExcel
Dim objSheet
Dim CellVal
Dim theROW
Dim theCOL
Dim maxCOLS
Dim maxROWS
Dim strVaultname
Dim strBankName
Dim theRange

Dim strExcelPath As String
Dim strExcelFileName As String
strExcelPath = "\\FDSPUBLIC\FDSPUBLIC\C\CASH SERVICES\Daily Status Reports\Unprocessed\"
strExcelFileName = "DSR BAC Dedham 02-04-2013.xls"
maxCOLS = 0
maxROWS = 0

' Open specified spreadsheet and select the first worksheet.
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Set objBook = objExcel.Workbooks.Open(strExcelPath & strExcelFileName)
'objExcel.Workbooks.Open strExcelPath
Set objSheet = objExcel.ActiveWorkBook.Worksheets(1)
objExcel.Sheets(1).Select

'Grab values from excel spreadsheet and add them to the table.

Dim strProcessingDate      'D2 & E2
Dim strVault     'K2
'Dim strBankName  'I2

        strProcessingDate = objSheet.cells(2, 4).Value & " " & objSheet.cells(2, 5)
        strVault = objSheet.cells(2, 12).Value
        strBankName = objSheet.cells(2, 10).Value

       DoCmd.TransferSpreadsheet transfertype:=acImport, SpreadsheetType:=acSpreadsheetTypeExcel12, _
            TableName:="NonCompliance_Staging", FileName:=strExcelPath, _
            Hasfieldnames:=False, Range:=theRange

    'Columns H & I are merged together in spreadsheet so need to delete out column I
        CurrentDb.Execute "ALTER TABLE NonCompliance_Staging DROP COLUMN F9;"
       
    'Update main table with temporary table data.
        CurrentDb.Execute "qryAddStagingDataToNonCompliance"

objBook.Close False
objExcel.Quit

Set objBook = Nothing
Set objExcel = Nothing
Set objSheet = Nothing

Dim objWorkbook
DoEvents
DoEvents
End Sub
Avatar of Rey Obrero (Capricorn1)
Rey Obrero (Capricorn1)
Flag of United States of America image

you forgot to include the name of the excel file here


       DoCmd.TransferSpreadsheet transfertype:=acImport, SpreadsheetType:=acSpreadsheetTypeExcel12, _
            TableName:="NonCompliance_Staging", FileName:=strExcelPath, _
            Hasfieldnames:=False, Range:=theRange

it should be

       DoCmd.TransferSpreadsheet transfertype:=acImport, SpreadsheetType:=acSpreadsheetTypeExcel12, _
            TableName:="NonCompliance_Staging", FileName:=strExcelPath & strExcelFileName, _
            Hasfieldnames:=False, Range:=theRange
Personally, I don't understand why you are opening Excel at all?

The only reason to open the file is to get these three values, but I don't see how they are used in your code, so I don't understand the purpose for opening the file at all.

        strProcessingDate = objSheet.cells(2, 4).Value & " " & objSheet.cells(2, 5)
        strVault = objSheet.cells(2, 12).Value
        strBankName = objSheet.cells(2, 10).Value
Avatar of flfmmqp
flfmmqp

ASKER

Sorry I was trying to keep the code as simple to view as possible.  I have no problems with importing the information to do what I want.  It becomes an issue when I want to close the excel file and move onto the next one.  It would be a lot more code but mostly altering tables and then moving the data from a staging table to the real table.  

Again the big issue is when I go to close the excel file and move to the next one. It just doesn't want to close the file and so I end up with a bunch of open excel files which is very annoying to the user.   I'm looping through a series of excel files in a folder.
< I'm looping through a series of excel files in a folder. >

where is the code you use for the looping?


here is a sample looping code to import multiple excel files

Sub ImportXLFiles()
Dim xlFolder As String, xlFile As String, xlPath As String
Dim xlObj As Object, i As Integer,  sTable as string

    xlFolder = "C:\MyFolder\"

xlFile = Dir(xlFolder & "*.xls")
    While xlFile <> ""
    Set xlObj = CreateObject("Excel.Application")
         sTable=left(xlFile,len(xlFile)-4)
        xlPath = xlFolder & xlFile
        xlObj.Workbooks.Open xlPath, , True
        With xlObj

               DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
                sTable, xlPath, True, .worksheets(1).Name & "!"
           
 
        End With
        xlObj.Quit
        Set xlObj = Nothing

        xlFile = Dir
    Wend
Msgbox "Done"
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Steve
Steve
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of flfmmqp

ASKER

In the interest of full disclosure here is all of my code I believe.  I guess by trying to make it simplier I was making it harder.  


'Import Excel Data into temporary files - Done
'Move files into temporary folder so they are not processed again - Done
'Add columns and fill them in for things like Processed Date, User, Vault Name, Bank Name etc. Done
'Move data over to main tables Done
'Delete temporary tables (staging tables) Done
'Close all excel files - Argh Not Done.

Private Sub cmdImportDSR_Click()

Dim strGetDate As String
Dim strNewFilesPath As String
Dim strMoveProcessedFilesPath As String
strGetDate = Replace(Date, "/", "_")

    strNewFilesPath = "\\FDSPUBLIC\FDSPUBLIC\C\CASH SERVICES\Daily Status Reports\Unprocessed"
    strMoveProcessedFilesPath = "\\FDSPUBLIC\FDSPUBLIC\C\CASH SERVICES\Daily Status Reports\Processed\" & strGetDate

fraProcessing.Move 0, 0
lblProcessing.Move 1, 0
fraProcessing.Visible = True
fraProcessing.SetFocus
DoEvents

ImportExcelInformationIntoAccessTable strNewFilesPath

fraProcessing.SetFocus
cmdImportDSR.Visible = True
cmdImportDSR.SetFocus
fraProcessing.Visible = False
DoEvents



MsgBox "Finished processing files!"


End Sub


Function ImportExcelInformationIntoAccessTable(strFolderPath As String) As String
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the folder object associated with the directory
Dim objFolder
Set objFolder = objFSO.GetFolder("" & strFolderPath & "")

'Loop through the Files collection
Dim objFile
For Each objFile In objFolder.Files
'Check to see if file is something we can import.
If objFile.Type = "Microsoft Excel 97-2003 Worksheet" Then
     'Found file to import
     Dim strFileNameAndPath
     strFileNameAndPath = strFolderPath & "\" & objFile.Name
     
        ImportExcelDataIntoAccess "" & strFileNameAndPath & "", objFile.Name
    '**********************
End If
    Next
'Clean up!
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing


If TableExists("NonCompliance_Staging") Then
    CurrentDb.TableDefs.Delete ("NonCompliance_Staging")
End If

If TableExists("Counterfeit_Staging") Then
    CurrentDb.TableDefs.Delete ("Counterfeit_Staging")
End If


End Function




Sub ImportExcelDataIntoAccess(strExcelPath As String, strExcelFileName As String)
Dim objExcel
Dim objSheet
Dim CellVal
Dim theROW
Dim theCOL
Dim maxCOLS
Dim maxROWS
Dim strVaultname
Dim strBankName
Dim theRange

If TableExists("NonCompliance_Staging") Then
    CurrentDb.TableDefs.Delete ("NonCompliance_Staging")
End If

If TableExists("Counterfeit_Staging") Then
    CurrentDb.TableDefs.Delete ("Counterfeit_Staging")
End If

maxCOLS = 0
maxROWS = 0


' Open specified spreadsheet and select the first worksheet.
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.DisplayAlerts = False
Set objBook = objExcel.Workbooks.Open(strExcelPath)
'objExcel.Workbooks.Open strExcelPath
Set objSheet = objExcel.ActiveWorkBook.Worksheets(1)
objExcel.Sheets(1).Select

'Grab values from excel spreadsheet and add them to the table.

Dim strProcessingDate      'D2 & E2
Dim strVault     'K2
'Dim strBankName  'I2

        strProcessingDate = objSheet.cells(2, 4).Value & " " & objSheet.cells(2, 5)
        strVault = objSheet.cells(2, 12).Value
        strBankName = objSheet.cells(2, 10).Value

lblProcessing.Caption = "Processing File: " & strExcelFileName


'****** Non Compliance Issues ******
'get the number of rows
    theROW = 108
    theRange = "A9:J" & theROW
       DoCmd.TransferSpreadsheet transfertype:=acImport, SpreadsheetType:=acSpreadsheetTypeExcel12, _
            TableName:="NonCompliance_Staging", FileName:=strExcelPath, _
            Hasfieldnames:=False, Range:=theRange

DoEvents

        CurrentDb.Execute "ALTER TABLE NonCompliance_Staging ADD COLUMN ProcessingDate TEXT(25);"
        CurrentDb.Execute "Update NonCompliance_Staging SET ProcessingDate='" & strProcessingDate & "' WHERE ProcessingDate IS NULL"
        CurrentDb.Execute "ALTER TABLE NonCompliance_Staging ADD COLUMN Vault TEXT(100);"
        CurrentDb.Execute "Update NonCompliance_Staging SET Vault='" & strVault & "' WHERE Vault IS NULL"
        CurrentDb.Execute "ALTER TABLE NonCompliance_Staging ADD COLUMN Bank TEXT(100);"
        CurrentDb.Execute "Update NonCompliance_Staging SET Bank='" & strBankName & "' WHERE Bank IS NULL"
        CurrentDb.Execute "ALTER TABLE NonCompliance_Staging ADD COLUMN EntryDate DATE;"
        CurrentDb.Execute "Update NonCompliance_Staging SET EntryDate = DATE() WHERE EntryDate IS NULL"
       

        CurrentDb.Execute "ALTER TABLE NonCompliance_Staging ADD COLUMN FileName TEXT(100);"
        CurrentDb.Execute "Update NonCompliance_Staging SET FileName='" & Replace(strExcelFileName, "'", "") & "' WHERE FileName IS NULL"
      

    'Columns H & I are merged together in spreadsheet so need to delete out column I
        CurrentDb.Execute "ALTER TABLE NonCompliance_Staging DROP COLUMN F9;"
       
    'Update main table with temporary table data.
        CurrentDb.Execute "qryAddStagingDataToNonCompliance"

DoEvents

    'End If
    
    
'***** Counterfeit Notes Detected******
'get the number of rows
    theROW = 108
    theRange = "M9:R" & theROW
        
            DoCmd.TransferSpreadsheet transfertype:=acImport, SpreadsheetType:=acSpreadsheetTypeExcel12, _
                    TableName:="Counterfeit_Staging", FileName:=strExcelPath, _
                    Hasfieldnames:=False, Range:=theRange
DoEvents
            
            CurrentDb.Execute "ALTER TABLE Counterfeit_Staging ADD COLUMN ProcessingDate TEXT(25);"
            CurrentDb.Execute "Update Counterfeit_Staging SET ProcessingDate='" & strProcessingDate & "' WHERE ProcessingDate IS NULL"
            CurrentDb.Execute "ALTER TABLE Counterfeit_Staging ADD COLUMN Vault TEXT(100);"
            CurrentDb.Execute "Update Counterfeit_Staging SET Vault='" & strVault & "' WHERE Vault IS NULL"
            CurrentDb.Execute "ALTER TABLE Counterfeit_Staging ADD COLUMN Bank TEXT(100);"
            CurrentDb.Execute "Update Counterfeit_Staging SET Bank='" & strBankName & "' WHERE Bank IS NULL"
            CurrentDb.Execute "ALTER TABLE Counterfeit_Staging ADD COLUMN EntryDate DATE;"
            CurrentDb.Execute "Update Counterfeit_Staging SET EntryDate=DATE() WHERE EntryDate IS NULL"
            CurrentDb.Execute "ALTER TABLE Counterfeit_Staging ADD COLUMN FileName TEXT(100);"
            CurrentDb.Execute "Update Counterfeit_Staging SET FileName='" & Replace(strExcelFileName, "'", "") & "' WHERE FileName IS NULL"
        
        'Update main table with temporary table data.
        CurrentDb.Execute "qryAddStagingDataToCounterfeit"
D
oEvents
objBook.Close False
DoEvents
'objExcel.Workbooks.Close
objExcel.Quit
DoEvents
Set objBook = Nothing
Set objExcel = Nothing
Set objSheet = Nothing

Dim objWorkbook
DoEvents
DoEvents

Dim strGetDate As String
Dim strNewFilesPath As String
Dim strMoveProcessedFilesPath As String
strGetDate = Replace(Date, "/", "_")

    strNewFilesPath = "\\FDSPUBLIC\FDSPUBLIC\C\CASH SERVICES\Daily Status Reports\Unprocessed"
    strMoveProcessedFilesPath = "\\FDSPUBLIC\FDSPUBLIC\C\CASH SERVICES\Daily Status Reports\Processed\" & strGetDate

'Make sure folder is created
CreateFolder strMoveProcessedFilesPath

'Move file from unprocessed to processed.
Move_File_In_Folder_To_A_New_Folder strExcelPath, strMoveProcessedFilesPath & "\"



End Sub

Open in new window

flfmmqp,

did you see my post at http:#a38855296 ?
Avatar of flfmmqp

ASKER

Yes I did and thanks for posting it but I don't see how it is different in trying to close the excel files from what I am doing.  

DoEvents
objBook.Close False
DoEvents
'objExcel.Workbooks.Close
objExcel.Quit
DoEvents
Set objBook = Nothing
Set objExcel = Nothing
Set objSheet = Nothing

Currently the answer TheBarman has given would work but I would like to close only the files I have opened via my code but this would work as a solution just not maybe the best solution.
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.