Converting txt-files to xls from within MS Access 2000 2

[Thingol]

Hi All,

I have created the code below (code block 1) to convert sets of tab-separated text files to MS-excel (2000) workbooks. I want to import the excel-files into MS-Access (2000), and I would prefer to run the conversion routine from text to excel from within Access as well. This way I could do the conversion and import into Access with the push of just one button.

I am not quite familiar with the way to approach Excel from within Access. I tried adapting the code below (code block 1) to a piece of code I could use in Access. This doesn't work, since I'm using some functions that I think may not be available from within Access. (see code block 2) How could I adapt the code in code block 1 to successfully convert all the txt-files to xls?

I hope some one can help me out! Any help will be greatly appreciated.

Best regards,
Martijn Senden.
p.s. Some of the code is in Dutch, such as the comments and the variables. I hope this doesn't make too much of a difference. If it does, I'd be happy to translate the code.

code block 1 - Converting text-files to xls-files from within Excel

Option Explicit

Sub Tekstbestand_converteren()
Dim Titel As String
Dim Filter As String, Title As String, msg As String
Dim i As Integer, FilterIndex As Integer
Dim Bestandsnaam As Variant
Dim Pad As String
Dim Station As String
Dim Bericht As String

' Bestandsfilters
Filter = "Text Files (*.txt),*.txt,"
' Standaardfilter instellen op *.txt
FilterIndex = 1

' Stel de titel van het dialoogvenster in
Titel = "Kies de bestand(en) die u wilt openen"

' Kies de drive en het pad waarin gewerkt moet worden
Pad = ThisWorkbook.Path
Station = Left(Pad, 1)
ChDrive (Station)
ChDir (Pad)

With Application
    ' Stel het Array van bestandsnamen in op de geselecteerde bestanden (toestaan meerdere bestanden)
    Bestandsnaam = .GetOpenFilename(Filter, FilterIndex, Titel, , True)
    ' Reset het beginstation/-pad
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
End With

' Stoppen als er geannuleerd wordt
If Not IsArray(Bestandsnaam) Then
    MsgBox "Er was geen bestand geselecteerd."
    Exit Sub
End If

' Bestanden openen
For i = LBound(Bestandsnaam) To UBound(Bestandsnaam)
    Workbooks.OpenText Filename:=Bestandsnaam(i), DataType:=xlDelimited, Tab:=True
    Workbooks(Workbooks.Count).SaveAs Filename:=(Pad & "\xls\" & Left(Workbooks(Workbooks.Count).Name, Len(Workbooks(Workbooks.Count).Name) - 4)), FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    Workbooks(Workbooks.Count).Close
Next i
MsgBox Bericht, vbInformation, i - 1 & " Bestanden geconverteerd" ' Dit kan worden verwijderd

End Sub

code block 2 - Adaption of conversion-code to get it to work from within Access (it doesn't work)

Sub conversie_tekst_excel()
'Excelobjecten declareren en instellen
Dim objXLApp As Object
Dim objXLBook As Object
Set objXLApp = CreateObject("Excel.Application")
Set objXLBook = objXLApp.Workbooks.Open("c:\workbook1")
    
'Variabelen voor conversieroutine declareren
Dim Titel As String
Dim Filter As String, Title As String, msg As String
Dim i As Integer, FilterIndex As Integer
Dim Bestandsnaam As Variant
Dim Pad As String
Dim Station As String
Dim Bericht As String

'Excel starten en conversie van tekstbestanden uitvoeren
With objXLApp
    ' Bestandsfilters
    Filter = "Text Files (*.txt),*.txt,"
    ' Standaardfilter instellen op *.txt
    FilterIndex = 1
    
    ' Stel de titel van het dialoogvenster in
    Titel = "Kies de bestand(en) die u wilt openen"
    
    ' Kies de drive en het pad waarin gewerkt moet worden
    Pad = CurrentProject.Path
    MsgBox (Pad)
    Exit Sub
    
    Station = Left(Pad, 1)
    ChDrive (Station)
    ChDir (Pad)
    
    ' Stel het Array van bestandsnamen in op de geselecteerde bestanden (toestaan meerdere bestanden)
    Bestandsnaam = .GetOpenFilename(Filter, FilterIndex, Titel, , True)
    ' Reset het beginstation/-pad
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
    
    ' Stoppen als er geannuleerd wordt
    If Not IsArray(Bestandsnaam) Then
        MsgBox "Er was geen bestand geselecteerd."
        Exit Sub
    End If
    
    ' Bestanden openen
    For i = LBound(Bestandsnaam) To UBound(Bestandsnaam)
        Workbooks.OpenText Filename:=Bestandsnaam(i), DataType:=xlDelimited, Tab:=True
        Workbooks(Workbooks.Count).SaveAs Filename:=(Pad & "\xls\" & Left(Workbooks(Workbooks.Count).Name, Len(Workbooks(Workbooks.Count).Name) - 4)), FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        Workbooks(Workbooks.Count).Close
    Next i
    'MsgBox Bericht, vbInformation, i - 1 & " Bestanden geconverteerd" ' Dit kan worden verwijderd
End With

End Sub

In the Beginning there was nothing, which exploded.

--Terry Pratchett, Lords and Ladies--

 

[PHV]

Full qualify each excel object, eg:
[!].[/!]Workbooks.OpenText

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[JerryKlmns]

I don 't think you need this line

Set objXLBook = objXLApp.Workbooks.Open("c:\workbook1")

but you do need the following two

objXLApp.Quit
Set objXLApp = Nothing

just before the End Sub

Plus what PHV says

 

[Thingol]

Hi PH,

Thanks for your reply. I changed my code. I still get an error (variable undefined). Below is the code I use. I highlighted the code Access doesn't understand.

Best regards,
Martijn Senden.

Sub conversie_tekst_excel()
'Excelobjecten declareren en instellen
Dim objXLApp As Object
Dim objXLBook As Object
Set objXLApp = CreateObject("Excel.Application")
Set objXLBook = objXLApp.Workbooks.Open("c:\workbook1")
    
'Variabelen voor conversieroutine declareren
Dim Titel As String
Dim Filter As String, Title As String, msg As String
Dim i As Integer, FilterIndex As Integer
Dim Bestandsnaam As Variant
Dim Pad As String
Dim Station As String
Dim Bericht As String

'Excel starten en conversie van tekstbestanden uitvoeren
With objXLApp
    ' Bestandsfilters
    Filter = "Text Files (*.txt),*.txt,"
    ' Standaardfilter instellen op *.txt
    FilterIndex = 1
    
    ' Stel de titel van het dialoogvenster in
    Titel = "Kies de bestand(en) die u wilt openen"
    
    ' Kies de drive en het pad waarin gewerkt moet worden
    Pad = Left$(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name))) & "xls\"
    MsgBox (Pad)
    Exit Sub
    
    Station = Left(Pad, 1)
    ChDrive (Station)
    ChDir (Pad)
    
    ' Stel het Array van bestandsnamen in op de geselecteerde bestanden (toestaan meerdere bestanden)
    Bestandsnaam = .GetOpenFilename(Filter, FilterIndex, Titel, , True)
    ' Reset het beginstation/-pad
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
    
    ' Stoppen als er geannuleerd wordt
    If Not IsArray(Bestandsnaam) Then
        MsgBox "Er was geen bestand geselecteerd."
        Exit Sub
    End If
    
    DoCmd.Hourglass True 'Zandloper aanzetten
    
    ' Bestanden openen
    For i = LBound(Bestandsnaam) To UBound(Bestandsnaam)
        .Workbooks.OpenText FileName:=Bestandsnaam(i), DataType:=[highlight]xlDelimited[/highlight], Tab:=True
        .Workbooks(.Workbooks.Count).SaveAs FileName:=(Pad & "\xls\" & Left(.Workbooks(.Workbooks.Count).Name, Len(.Workbooks(.Workbooks.Count).Name) - 4)), FileFormat:=[highlight]xlNormal[/highlight], Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        .Workbooks(.Workbooks.Count).Close
    Next i
    'MsgBox Bericht, vbInformation, i - 1 & " Bestanden geconverteerd" ' Dit kan worden verwijderd
    
    DoCmd.Hourglass False 'Zandloper uitzetten
End With

End Sub

In the Beginning there was nothing, which exploded.

--Terry Pratchett, Lords and Ladies--

 

[JerryKlmns]

You are using late binding

Dim objXLApp As Object
Set objXLApp = CreateObject("Excel.Application")

so constants of that object mean nothing. Change them to their equivelant value

xlDelimited = 1
xlNormal = -4143

 

[Thingol]

Hi Jerry,

Yes, I still need to clean things up. Thanks for the tips for those extra lines of code. Problem remains: Access sees things as a variable. Maybe because DataType is something entirely different in Access (a field property) than what I'm trying to use it for?

I hope someone knows a way around this problem!

Best regards,
Martijn Senden.

In the Beginning there was nothing, which exploded.

--Terry Pratchett, Lords and Ladies--

 

[Thingol]

Thanks Jerry,

Our last two posts crossed each other. I tried your suggestions and they worked! I had to clean up some other errors of my own, but now the code runs smoothly!

Thanks and a star! (Also for PHV, for his valid remark).

Regards,
Martijn Senden.
p.s. The code I have now:

'Excelobjecten declareren en instellen
Dim objXLApp As Object
Set objXLApp = CreateObject("Excel.Application")
    
'Variabelen voor conversieroutine declareren
Dim Titel As String
Dim Filter As String, Title As String, msg As String
Dim i As Integer, FilterIndex As Integer
Dim Bestandsnaam As Variant
Dim Pad As String
Dim Station As String
Dim Bericht As String

'Excel starten en conversie van tekstbestanden uitvoeren
With objXLApp
    ' Bestandsfilters
    Filter = "Text Files (*.txt),*.txt,"
    ' Standaardfilter instellen op *.txt
    FilterIndex = 1
    
    ' Stel de titel van het dialoogvenster in
    Titel = "Kies de bestand(en) die u wilt openen"
    
    ' Kies de drive en het pad waarin gewerkt moet worden
    Pad = Left$(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name)))
    Station = Left(Pad, 1)
    ChDrive (Station)
    ChDir (Pad)
    
    ' Stel het Array van bestandsnamen in op de geselecteerde bestanden (toestaan meerdere bestanden)
    Bestandsnaam = .GetOpenFilename(Filter, FilterIndex, Titel, , True)
    ' Reset het beginstation/-pad
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
    
    ' Stoppen als er geannuleerd wordt
    If Not IsArray(Bestandsnaam) Then
        MsgBox "Er was geen bestand geselecteerd."
        Exit Sub
    End If
    
    DoCmd.Hourglass True 'Zandloper aanzetten
    
    ' Bestanden openen
    For i = LBound(Bestandsnaam) To UBound(Bestandsnaam)
        .Workbooks.OpenText FileName:=Bestandsnaam(i), DataType:=1, Tab:=True
        .Workbooks(.Workbooks.Count).SaveAs FileName:=(Pad & "xls\" & Left(.Workbooks(.Workbooks.Count).Name, Len(.Workbooks(.Workbooks.Count).Name) - 4)), FileFormat:=-4143, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        .Workbooks(.Workbooks.Count).Close
    Next i
    'MsgBox Bericht, vbInformation, i - 1 & " Bestanden geconverteerd" ' Dit kan worden verwijderd
    
    DoCmd.Hourglass False 'Zandloper uitzetten
End With

objXLApp.Quit
Set objXLApp = Nothing

End Sub

In the Beginning there was nothing, which exploded.

--Terry Pratchett, Lords and Ladies--