Convert to Excel Files and Import into Access Database (1 Viewer)

[whitedove]

I have files that have extension of TSV which are text files but viewable in exel. I figured out a way for the user to click on a button in Access which does the following
1. Run Macro in Excel: The macro prompts the user to select the TSV file. After selection, macro opens the employee.tsv file in the excel (with excel being invisible) and saves it as employee.xls
The code for the macro may be its helpful for anyone else:

Sub SaveTSVtoXLS()


Dim myPath As String
Dim myString As Variant



    Application.DisplayAlerts = False


    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .Show
        myPath = .SelectedItems(1)
    End With


    Workbooks.Open Filename:=myPath


    myString = Split(myPath, ".")
    myPath = myString(0)
    

    ActiveWorkbook.SaveAs Filename:=myPath & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close
    

    Application.DisplayAlerts = True

End Sub

The code for running Excel Macro from Access

'---------------------------------------------------------------------------------------
' Procedure : RunXLSMacro
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Open the specifed Excel workbook and run the specified macro and then
'             close the workbook.
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Sep-09                 Initial Release
'---------------------------------------------------------------------------------------
    

    Sub RunExcelMacro()
    Dim xl As Object
     
    'Step 1:  Start Excel, then open the target workbook.
       Set xl = CreateObject("Excel.Application")
        xl.Workbooks.Open ("H:\ConvertTSVtoXLSX.xlsm")
     
    'Step 2:  Make Excel visible
       xl.Visible = True
     
    'Step 3:  Run the target macro
       xl.Run "SaveTSVtoXLS"
     
    'Step 4:  Close and save the workbook, then close Excel
       xl.ActiveWorkbook.Close (True)
        xl.Quit
     
    'Step 5:  Memory Clean up.
       Set xl = Nothing
     
    End Sub

2. Imports the Excel file (employee.xls) into two tables: tblEmployee and tblDepartment using the following codes.

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "qryDepartment", selectFile, True - 1, "A1:C2"
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "qryEmployee", selectFile, True - 1, "A1:AE2"

Everything is working flawless except that the user has to select the file three times
1 time for the tsv
2 times for the xls file
Is there a way that the user can select the file only once (tsv file) or
at least only twice one of the tsv file and the other for the xls file?

Thank you

 

[sxschech]

This may be more code, but will allow user to select file to import and convert to excel format, changes cols to character to avoid numeric/text issues. Allows to keep name of file as table name or lets user pick a new name to call the table. Despite code saying need to set a reference to excel, code is modified to not need a reference. Also, due to excel version issues, ended up hard coding the version to save as current version of excel prior to import. The import process creates a temp file, so it doesn't alter the original. You will need to add or change the extensions in the code for the file extensions you want to show up.

Put this in a form. If you are using a button, then change the sub to the button's click event.

Hopefully, I didn't leave anything out.

'This is on form

Public Sub DirectImport()
'Import Excel or Text file without using a template
'20150523
    On Error GoTo exiterr
    Dim stimport As String
    Dim stImportErrTable As String
    Dim stTableName As String
    Dim stSheetType As Integer
    
    stimport = selectFile("Excel")
    stTableName = Mid(stimport, InStrRev(stimport, "\") + 1)
    stTableName = Mid(stTableName, 1, InStr(stTableName, ".") - 1)
    stTableName = Replace(stTableName, "-", "_")
    
    stTableName = InputBox("Enter Name for this table", "Import Excel Sheet", stTableName)
    stTableName = Replace(stTableName, "-", "_") 'this one is in case user keys in a new name with dash
    'Convert excel cell data format to text file prior to import
    Me.txtLastImport = ""
    Call ExcelToText(stimport)
    If TableExists(stTableName) Then
        DoCmd.DeleteObject acTable, stTableName
    End If
    
    stimport = Replace(stimport, ".xl", "txt.xl")
    stimport = Replace(stimport, ".csv", "txt.xlsx")
    'stSheetType = globalintExcelVer     'ExcelVersion(stimport)
    'DoCmd.TransferSpreadsheet acImport, stSheetType, stTableName, stimport, True
    DoCmd.TransferSpreadsheet acImport, 9, stTableName, stimport, True
    stImportErrTable = Left(stTableName, 31)
    'Remove "Text" version after import as no longer needed and to keep
    'directory clean.  If the file needs to be re imported, the above code
    'regenerates the file anyway.
    Call DeleteFile(stimport)
    DoCmd.SetWarnings True
    Exit Sub
exiterr:
    DoCmd.SetWarnings True
    MsgBox Err.Number & " " & Err.Description
    Exit Sub
End Sub

This goes in the modules section not in the form

public globalintExcelVer as Integer

Function selectFile(filetype As String)
'--------------------------------------------------
' File Browse Code
'--------------------------------------------------
'NOTE: To use this code, you must reference
'The Microsoft Office 14.0 (or current version)
'Object Library by clicking menu Tools>References
'Check the box for:
'Microsoft Office 14.0 Object Library in Access 2010
'Microsoft Office 15.0 Object Library in Access 2013
'Click OK
'http://www.ntechcomm.com/2013/08/select-a-file-with-file-dialog-in-ms-access-with-vba/
'--------------------------------------------------

    Dim Fd As office.FileDialog, FileName As String
    Set Fd = Application.FileDialog(msoFileDialogFilePicker)
    'disable multiselect for one file selection
    Fd.AllowMultiSelect = False
    Fd.Filters.Clear
    If filetype = "Excel" Then
        Fd.Filters.Add "Excel or Text Files", "*.xls;*.xlsx;*.xlsm;*.csv;*.txt", 1
    Else
        Fd.Filters.Add "Access Files", "*.mdb;*.accdb", 1
    End If
    If Fd.Show = True Then
        FileName = Fd.SelectedItems(1)
    End If
     
    'clear file dialog
    Set Fd = Nothing
    'Return File name and path
    selectFile = FileName
End Function

Function TableExists(strTableName As String) As Boolean
'http://www.pcreview.co.uk/forums/there-way-test-if-table-exists-vba-t1145544.html
On Error Resume Next
TableExists = IsObject(CurrentDb.TableDefs(strTableName))
End Function

Public Sub DeleteFile(Killfile As String)
'http://word.mvps.org/faqs/macrosvba/DeleteFiles.htm
'20150308
    If Len(Dir$(Killfile)) > 0 Then
        SetAttr Killfile, vbNormal
        Kill Killfile
    End If
End Sub

Public Sub ExcelToText(ByVal stfilepath As String)
'http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28277710.html
'http://www.developark.com/1529_17747527/
'http://www.mrexcel.com/forum/excel-questions/235867-using-column-numbers-define-range-visual-basic-applications.html
'Change the formatting of an excel file to text for all used cols (last col)
'Save as to another name (filename + txt.xlsx)
'Need to set a reference to Excel (tools references)
'20150228 ss
'Incorporated Version Check so file does not need to be reopened before import
'20150521
'Changed so no longer needs to set reference to excel
'Found that last col wasn't getting all data, switched to .cells without
'range in order to capture entire sheet.
'Changed to convert all reformatted files into Excel 2007-2013 format xlsx.
'-previously kept reformat in original version, but was causing issues down
'the road.  Simplifies import process as all imported files are now the
'same format.
'201506??

    Dim objapp As Object
    Dim wb As Object
    Dim lastcol As Long
    Dim ExcelVersion As Long
    
    On Error Resume Next
    Set objapp = CreateObject("Excel.Application")
    objapp.Visible = True
    
    If Dir(stfilepath) Then
        Set wb = objapp.workbooks.Open(stfilepath, True, False)
    End If
    With wb.Sheets(1)
        .cells.NumberFormat = "@"
        .Name.Delete
    End With
        'http://www.rondebruin.nl/win/s5/win001.htm
        'filefomatstuff 20150405
    wb.SaveAs FilePath(stfilepath) & FileNameNoExt(stfilepath) & "txt.xlsx", FileFormat:=51
    ExcelVersion = wb.FileFormat
    wb.Close 'savechanges:=False
  
        objapp.Quit

    Set objapp = Nothing
    Select Case ExcelVersion
        Case 39
            ExcelVersion = 5 'excel7
        Case 50, 51
            ExcelVersion = 9 'excel12 (2007-2013, xlsx)
        Case 56
            ExcelVersion = 8 'excel8 (97-2003 format in Excel 2007-2013, xls)
    End Select
    globalintExcelVer = ExcelVersion
End Sub

 

[whitedove]

Hello sxschech,
I tried the code.

Me.txtLastImport = ""

This was referring to a non-existent field so I removed it. I am not sure how important this is. After removing this, the code went through to let me select the file and to Enter the Name of the Table. Then in the module I got this error "Sub or Function not defind". and it highlighted on "FilePath" in the following code

 wb.SaveAs FilePath(stfilepath) & FileNameNoExt(stfilepath) & "txt.xlsx", FileFormat:=51

 

[sxschech]

Looks like I forgot to copy a few things...add this to the module.

Function FileNameNoExt(strPath As String) As String
 'https://sqlaccxl.wordpress.com/2013/03/06/vba-function-to-extract-file-name-withwithout-file-extension-or-path-only/
    Dim strTemp As String
    strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
    FileNameNoExt = Left$(strTemp, InStrRev(strTemp, ".") - 1)
End Function
 
'The following function returns the filename with the extension from the file's full path:
Function FileNameWithExt(strPath As String) As String
    FileNameWithExt = Mid$(strPath, InStrRev(strPath, "\") + 1)
End Function
 
'the following function will get the path only (i.e. the folder) from the file's ful path:
Function FilePath(strPath As String) As String
    FilePath = Left$(strPath, InStrRev(strPath, "\"))
End Function

Regarding your other question, the txtLastImport is not needed, I had that on my form to display to the user the name of the file that was imported once it was complete so they knew the program finished.

One other thing, you may need to set a reference to Microsoft Office XX.0 Object Library. Mine shows 15.0, yours may be different.

If you still have an issue, let me know.

 

[whitedove]

Sorry I don't have access to the database on the weekend. I will test on Monday and I will let you know if it works.

Thanks

 

[whitedove]

Sorry I took awhile to test the code. I couldn't make the code works based on my needs so I will let the users know to select the files twice to import it into the database

 

[sxschech]

What might I have missed that is causing you to need to select the file twice? Is there an intermediate step or is there another error message in the code I provided?

 

[whitedove]

My original code is the one that lets the users select the file twice. The reason for the file dialogue prompt twice is this code

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "qryDepartment", selectFile, True - 1, "A1:C2"
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "qryEmployee", selectFile, True - 1, "A1:AE2"

 

[sxschech]

If the data are coming from the same file or path, shouldn't need to select the file twice, the variable should provide the name of the file in both cases. The prompt for the user to select the file should happen before the transfer text and be assigned to a variable. That variable is then what is used in the transferspreadsheet statement.