• 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.
0
BrunoTremblay
Asked:
BrunoTremblay
  • 6
  • 3
  • 2
  • +2
3 Solutions
 
RichardCorrieCommented:
Try:
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
exlBook.close
objExcel.quit
set exlbook = nothing
set objexcel = nothing
end sub

Richard
0
 
DarkoLordCommented:
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
    ExcelBook.Save
    Set ExcelBook = Nothing
    ExcelApp.Quit
       
    Set ExcelApp = Nothing
    Set ExcelSheet = Nothing
    Set ExcelBook = Nothing
0
 
RichardCorrieCommented:
oops
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
exlBook.close
'remove temporay file
    Kill strTextFile
'tidy up
objExcel.quit
set exlbook = nothing
set objexcel = nothing
end sub

Richard
0
Get your problem seen by more experts

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

 
ColosseoCommented:
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
  oFile.Delete
Next

' Exit excel
oExcel.Quit

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

End Sub

HTH

Scott
0
 
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?
0
 
RichardCorrieCommented:
what about my, or Darko's, solution? they do the same thing!!!

R
0
 
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
0
 
BrunoTremblayAuthor Commented:
Is there a way to put coma instead of dot?
0
 
BrunoTremblayAuthor Commented:
What is the format to put and what is -4143
0
 
ColosseoCommented:
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

Scott
0
 
BrunoTremblayAuthor Commented:
thx
0
 
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.
0
 
mytfeinCommented:
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?
thx,
mytfein
0
 
DarkoLordCommented:
Yes that would be ok..
0
 
mytfeinCommented:
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....
mytfein

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()

LaunchExcel

ImportTextToExcel2

SaveExcelSpreadsheet

CloseExcel (True)

ImportSpreadsheetToAccess

End Sub

'=======================================
Private Sub LaunchExcel()
On Error Resume Next

If WasExcelRunningBeforeThisExecution Then
   blnExcelAlreadyRunning = True
    Set objExcel = GetObject(, "Excel.Application")
Else
    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


Err.Clear

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
objExcelActiveWkb.Save

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

Set objExcelActiveWS = Nothing
Set objExcelActiveWkb = Nothing

SaveExcelSpreadsheet_Exit:
     Exit Sub
   
SaveExcelSpreadsheet_Err:
     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
    objExcel.Quit
End If
objExcel.DisplayAlerts = True

CloseExcel_Exit:
'    Set objExcelActiveWkb = Nothing
    Set objExcel = Nothing

   
    Exit Sub
   
CloseExcel_Err:
    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")
              .Select
              .EntireRow.Insert
           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
          .Select
          .EntireColumn.AutoFit
     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, _
      HasFieldNames:=True

End Sub




0
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