• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 3440
  • Last Modified:

In VB, how to open a text file with an xls extension ans save it as a xls file

I receive that kind of file every day. it's a list of every transaction in a period.

Exemple (FT_3452345_234_34.xls) is a text like this
TypeD'Enregistrement      NoDeSéquenceFacturation      DateDeTransaction
D      443      2004-08-08      
D      443      2004-08-08      
D      443      2004-08-09      

it's an xls extension file but in reality it's a txt file with field separate by tabulation.

What I want is to open in excel each of those files that are in a specific directory and save them as real xls file with the same name in another specific directory. Then delete the original.

I want to do that from a vb code.

I want to do that because I import the real xls file in access after and access doesn't support import of xls extension file that are in reality text.
  • 6
  • 3
  • 2
  • +2
3 Solutions
Reference Microsoft Excel X.x object library

create procedure:

sub ResaveFile(byVal pstrFile as string)
'pstrfile is text file to change
dim objExcel as new excel.application
dim exlBook as excel.workbook
'open file specifying tab delimeters
set exlBook = objExcel.Workbooks.Open (Filename:=pstrFile, Format:=1)
' save file as xls format
exlBook.SaveAs Filename:="C:\wORK\test2.xls", FileFormat:=xlNormal
'close file
set exlbook = nothing
set objexcel = nothing
end sub

Dim ExcelApp As Excel.Application
    Dim ExcelBook As Excel.Workbook
    Dim ExcelSheet As Excel.Worksheet

    Set ExcelApp = Excel.Application
    'Set ExcelBook = ExcelApp.Workbooks.Add

    'Set ExcelSheet = ExcelBook.Worksheets(1)

    'ExcelApp.Visible = True

    ExcelApp.Workbooks.OpenText FileName:="c:\exceltest.xls", Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True _
        , Space:=False, Other:=False
    Set ExcelBook = ExcelApp.ActiveWorkbook
    ExcelBook.SaveAs "C:\xxxxxxxx.xls", xlWorkbookNormal
    Set ExcelBook = Nothing
    Set ExcelApp = Nothing
    Set ExcelSheet = Nothing
    Set ExcelBook = Nothing
procedure should be:

sub ResaveFile(byVal pstrFile as string)
'pstrfile is text file to change

dim objExcel as new excel.application
Dim exlBook As Excel.Workbook
Dim pstrFile As String
Dim strTextFile As String
Dim strFileName As String

' create temporary file
strFileName = Dir(pstrFile)
strTextFile = Left(pstrFile, InStr(1, pstrFile, strFileName) - 1)
strFileName = Left(strFileName, Len(strFileName) - 4) & ".txt"
strTextFile = strTextFile & strFileName
    Set exlBook = Workbooks.Open(Filename:=pstrFile, Format:=1)
' save to temporary file
    exlBook.SaveAs Filename:=strTextFile, FileFormat:=xlExcel4
' delete original file
    Kill pstrFile
' save back to original file
    exlBook.SaveAs Filename:=pstrFile, FileFormat:=xlExcel4
'close file
'remove temporay file
    Kill strTextFile
'tidy up
set exlbook = nothing
set objexcel = nothing
end sub

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

Hi Bruno

This code will run for each file in the specified folder, outputting the new file to the new specified folder with the existing name and delete the original as it goes

make_XLS "c:\tmpxls", "c:\tmpout\"

Sub make_XLS(str_In_Folder,str_Out_Folder)

Dim oExcel
Dim oFSO
Dim oFolder

' File System Object
Set oFSO = CreateObject("Scripting.FileSystemObject")

' Excel application
Set oExcel = CreateObject("Excel.Application")

' Connect to the folder where the original files are stored
Set oFolder = oFSO.GetFolder(str_In_Folder)

' For each file in the folder
For Each oFile In oFolder.Files

  ' Open the file as a tab delimited
  oExcel.Workbooks.OpenText oFile.Path, , , , , , 1

  ' Save the file out to the new folder with the original name
  oExcel.ActiveWorkbook.SaveAs str_Out_Folder & oFile.Name,-4143

  ' Close the new file
  oExcel.ActiveWorkbook.Close False

  ' Delete the old file

' Exit excel

' Tidy up
Set oFolder = Nothing
Set oFSO = Nothing
Set oExcel = Nothing

End Sub


BrunoTremblayAuthor Commented:
Colosseo , your solution is great but I need the excel format to contains coma instead of dot because the format of my number are like 12,34.

How can I replace dot by coma?
what about my, or Darko's, solution? they do the same thing!!!

BrunoTremblayAuthor Commented:
yeah , I know but colosseo solution use custom folder and If you didn't notice, it's an text file with a xls extansion, and not a .txt file
BrunoTremblayAuthor Commented:
Is there a way to put coma instead of dot?
BrunoTremblayAuthor Commented:
What is the format to put and what is -4143
Hi Bruno, Glad that helped!

How can I replace dot by comma?    Do you mean your input files are comma delimited rather than tab delimited?

What is the format to put and what is -4143?

-4143 is the Constant for xlWorkbookNormal which is the fileformat that the xls is saved into

If you open excel and go to Tools > Macro > Visual Basic Editor Then in Visual Basic Click View > Object Brower Then search for xlFileFormat you will see a list of the different formats you can save the file as and their corresponding values

BrunoTremblayAuthor Commented:
BrunoTremblayAuthor Commented:
I find how to do it myself, look in the msdn library for the function Workbooks.OpenText. The 15th parameter is xlDecimalSeparator or something like that, you can define it to what you want. If your text has dot for Decimal, you put ".".

From : http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbaxl10/html/xlmthOpenText.asp
"expression.OpenText(FileName, Origin, StartRow, DataType, TextQualifier, ConsecutiveDelimiter, Tab, Semicolon, Comma, Space, Other, OtherChar, FieldInfo, TextVisualLayout, DecimalSeparator, ThousandsSeparator, TrailingMinusNumbers, Local)"

That did the trick and I answred myself, thx.
Hi DarkoLord,

Normally, I post under EE access/vba.....

I was looking for info on: opentext, and found your posting

I have questions regarding your technique....

I would be glad to post a brand new question.....in this area.....

would that be ok?
Yes that would be ok..
Hi DarkoLord,

Thanks so much for your response....I no longer have my question......

I found the clue while surfing the web.....I have code that is similar to yours....yet, when the vba script  completed, excel was still running invisibly in task manager/processes.....

The clue I found was that using the vba generated by the excel macro recorder, in an access vba script, is dangerous, in that excel could still be  running invisibly....

So I continued to search the web for how others wrote scripts using .opentext, such as yours above (thank you), to clearly define excel objects. And yet, still excel was running invisibly...

finally I realized that the excel macro logic that I used to generate the headings for row 1, needed to be replaced with a different approach, once I did that, and ran the script, checked task manager, and excel.exe is no longer there.

Thanks again for your offer of support, the question has been resolved....

the working code appears below: (for anyone's future interest)

Option Compare Database

Option Explicit

Dim objExcel                        As Excel.Application
Dim objExcelActiveWkb           As Excel.Workbook
Dim objExcelActiveWS            As Excel.Worksheet

Dim blnExcelAlreadyRunning       As Boolean

Public Sub EagleUpload()




CloseExcel (True)


End Sub

Private Sub LaunchExcel()
On Error Resume Next

If WasExcelRunningBeforeThisExecution Then
   blnExcelAlreadyRunning = True
    Set objExcel = GetObject(, "Excel.Application")
    blnExcelAlreadyRunning = False
    Set objExcel = CreateObject("Excel.Application")
End If

 objExcel.Visible = True   'False
End Sub

Public Function WasExcelRunningBeforeThisExecution() As Boolean

On Error Resume Next

Set objExcel = GetObject(, "Excel.Application")

WasExcelRunningBeforeThisExecution = (Err.Number = 0) ' if err.number = 0, true else false
Debug.Print Err.Number
Debug.Print Err.Description


End Function

Public Sub SaveExcelSpreadsheet()

On Error GoTo SaveExcelSpreadsheet_Err

Const cstrPath As String = "c:\EagleEhsVisits.xls"
Kill cstrPath

Set objExcelActiveWkb = objExcel.ActiveWorkbook

objExcelActiveWkb.SaveAs Filename:=cstrPath, FileFormat:=xlNormal

objExcel.DisplayAlerts = False
objExcelActiveWkb.Close savechanges:=False
objExcel.DisplayAlerts = True

Set objExcelActiveWS = Nothing
Set objExcelActiveWkb = Nothing

     Exit Sub
     Select Case Err.Number
         Case 53     ' kill didn't find the file - ignore error
            'MsgBox Err.Number & "  " & Err.Description
            Resume Next
         Case Else
            MsgBox "Error # " & Err.Number & ": " & Err.Description
            Resume SaveExcelSpreadsheet_Exit
       End Select

End Sub

Public Sub CloseExcel(blnHowToCloseExcel As Boolean)

On Error GoTo CloseExcel_Err

' objExcelActiveWkb.Close savechanges:=False
objExcel.DisplayAlerts = False
If Not blnExcelAlreadyRunning Then
End If
objExcel.DisplayAlerts = True

'    Set objExcelActiveWkb = Nothing
    Set objExcel = Nothing

    Exit Sub
    MsgBox "Error # " & Err.Number & ": " & Err.Description
    Resume CloseExcel_Exit
End Sub

Public Sub ImportTextToExcel2()

 objExcel.Workbooks.OpenText _
       Filename:="C:\EHSPMMt.TXT", Origin:=xlWindows, StartRow _
        :=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(36, 2), Array _
        (45, 2), Array(52, 1), Array(60, 2), Array(86, 2), Array(121, 2), Array(146, 2), Array(150, _
        2), Array(152, 2), Array(161, 2), Array(163, 2), Array(174, 2), Array(186, 2), Array(197, 2 _
        ), Array(207, 2), Array(208, 2), Array(209, 2), Array(210, 2), Array(212, 2), Array(214, 2) _
        , Array(221, 2), Array(222, 2), Array(230, 2), Array(240, 2), Array(247, 2), Array(248, 2), _
        Array(250, 2), Array(261, 2), Array(270, 2), Array(280, 2), Array(290, 2), Array(297, 2), _
        Array(298, 2), Array(300, 2), Array(310, 2), Array(320, 2), Array(328, 2), Array(329, 2), _
        Array(330, 2), Array(334, 2), Array(340, 2), Array(341, 2), Array(410, 2), Array(480, 2), _
        Array(481, 2), Array(499, 2), Array(519, 2), Array(520, 2), Array(521, 2), Array(522, 2), _
        Array(530, 2))
' Exit Sub

Set objExcelActiveWS = objExcel.ActiveSheet

With objExcelActiveWS

           With .Rows("1:1")
           End With

              .Cells(1, 1).Value = "header"
              .Cells(1, 2).Value = "filler1"
              .Cells(1, 3).Value = "patientNumber"
              .Cells(1, 4).Value = "filler2"
              .Cells(1, 5).Value = "PatientName"
              .Cells(1, 6).Value = "PatientStreet"
              .Cells(1, 7).Value = "PatientCity"
              .Cells(1, 8).Value = "PatientCounty"
              .Cells(1, 9).Value = "PatientState"
              .Cells(1, 10).Value = "PatientZip"
              .Cells(1, 11).Value = "PatienCountry"
              .Cells(1, 12).Value = "filler3"
              .Cells(1, 13).Value = "PatientPhone"
              .Cells(1, 14).Value = "PatientSSn"
              .Cells(1, 15).Value = "PatientDOB"
              .Cells(1, 16).Value = "G1"
              .Cells(1, 17).Value = "M1"
              .Cells(1, 18).Value = "filler4"
              .Cells(1, 19).Value = "R1"
              .Cells(1, 20).Value = "Rel"
              .Cells(1, 21).Value = "Chart#"
              .Cells(1, 22).Value = "E1"
              .Cells(1, 23).Value = "Medicare#"
              .Cells(1, 24).Value = "Medicaid#"
              .Cells(1, 25).Value = "filler5"
              .Cells(1, 26).Value = "E2"
              .Cells(1, 27).Value = "filler6"
              .Cells(1, 28).Value = "filler7"
              .Cells(1, 29).Value = "filler8"
              .Cells(1, 30).Value = "filler9"
              .Cells(1, 31).Value = "filler10"
              .Cells(1, 32).Value = "filler11"
              .Cells(1, 33).Value = "T1"
              .Cells(1, 34).Value = "filler12"
              .Cells(1, 35).Value = "filler13"
              .Cells(1, 36).Value = "filler14"
              .Cells(1, 37).Value = "filler15"
              .Cells(1, 38).Value = "I1"
              .Cells(1, 39).Value = "filler16"
              .Cells(1, 40).Value = "filler17"
              .Cells(1, 41).Value = "filler18"
              .Cells(1, 42).Value = "U1"
              .Cells(1, 43).Value = "filler19"
              .Cells(1, 44).Value = "filler20"
              .Cells(1, 45).Value = "U2"
              .Cells(1, 46).Value = "filler21"
              .Cells(1, 47).Value = "E3"
              .Cells(1, 48).Value = "I2"
              .Cells(1, 49).Value = "R2"
              .Cells(1, 50).Value = "A2"
              .Cells(1, 51).Value = "UDATE"

     With .Cells
     End With

End With
End Sub

Public Sub ImportSpreadsheetToAccess()

Dim strExcelFile As String
Dim strTableName As String

Dim strSql       As String

strExcelFile = "c:\EagleEhsVisits.xls"
strTableName = "T_EagleEhsVisits2"
strSql = "DELETE FROM " & strTableName
CurrentDb.Execute (strSql)

DoCmd.TransferSpreadsheet _
      TransferType:=acImport, _
      SpreadsheetType:=8, _
      TableName:=strTableName, _
      Filename:=strExcelFile, _

End Sub

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 6
  • 3
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now