Excel File To a Text File

[pbt]

I'm having problems converting to a text file from Excel.

The below code worked in 2003, but now I have put it in 2007 with just a change in the Range to work with.

What I'm getting is a Text file with, for lack of a better term, hyroglifics (sp).
Not the numbers that I should get like I got in 2003.

Private Sub CommandButtonExportPAG_Click()
    Application.ScreenUpdating = False
    On Error GoTo errTrap
    '//Hide the rows with 0 values
    LastRow = Range("S65536").End(xlUp).Row
     For r = LastRow To 263 Step -1
        If (Range("S" & r).Value = 0) Then
            Rows(r).Delete
        End If
    Next r
Application.Wait (Now + TimeValue("0:00:01"))
    Range("K264", Range("S264").End(xlDown).Offset(0, -1)).Copy
        Sheets.Add
        ActiveSheet.Name = "TEMP"
    Selection.PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
    Application.Range("A1").Select

    Sheets("TEMP").Copy
    Application.DisplayAlerts = False

    ActiveWorkbook.SaveAs Filename:= _
        "E:\Documents and Settings\michele_p.NSP\Desktop\Job Setup.txt", FileFormat _
        :=xlText, CreateBackup:=False
    
    ActiveWindow.Close
    ActiveWindow.SelectedSheets.Delete
        Sheets("PAG").Range("K264", Range("S264").End(xlDown)).ClearContents
        Range("A1").Select
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    SplashForm.Show
    Exit Sub
errTrap:
    Application.Dialogs(xlDialogSaveAs).Show ("Job Setup.txt")
    ActiveWindow.Close
    ActiveWindow.SelectedSheets.Delete
        Sheets("PAG").Range("K264", Range("S264").End(xlDown)).ClearContents
         Range("A1").Select
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    SplashForm.Show
         
End Sub

Anybody have an idea?

Thanks
Harry

 

[jindon]

Run this code first and see if this cleans the data...

Sub myClean()
With Sheets("PAG").Cells
    .Replace what:=Chr(9), replacement:="", Lookat:=xlPart
    .Replace what:=Chr(160), replacement:=""
End With
End Sub

 

[pbt]

Ran myClean() and then test()

Same thing, still get the little rectangle

 

[jindon]

How about

Sub test()
Dim fn As String, txt As String
fn = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Job Setup.txt"
<!-- / message -->With Sheets("YourSheetnameHere")  '<- change chere
    For Each r In .Range("s264", .Range("s" & Rows.Count).End(xlUp))
        If r.Value <> 0 Then txt = txt & vbCrLf & _
        Join(Evaluate("transpose("transpose(" _
        & r.Offset(,-8).Resize(,9).Address & "))"),vbTab)
    Next
End With
With CreateObject("VBScript.RegExp")
    .Pattern = "[\f\n\r\v]"
    .Global = True
    txt = .replace(txt, vbCrLf)
    .Pattern = "\n{2,}"
    txt = .replace(txt, vbCrLf)
End With
Open fn For Output As #1
    Print #1, Mid$(txt,2)
Close #1
End Sub

 

[pbt]

Just a helpfull thought, if it helps:

When I open the Text file the cursor is to the left of the unwanted character.

Is it possible to do a command that will imenate the Delete key to get rid of the unwanted character before Close. But to happen on the first "record" only?

Harry

 

[pbt]

Disregard my last post. I posted before your post.

Trying now.

 

[jindon]

Harry

How are you opening "Text file" after processed ?
Don't open it via Excel, open it with Text editor like NotePad, MSWord...

 

[pbt]

Had a few typo's in the With staement wich I managed to correct.

Sub test1()
Dim fn As String, txt As String
fn = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Job Setup.txt"
With Sheets("PAG")  '<- change chere
    For Each r In .Range("s264", .Range("s" & Rows.Count).End(xlUp))
        If r.Value <> 0 Then txt = txt & vbCrLf & Join(Evaluate("transpose(transpose(" & _
         r.Offset(, -8).Resize(, 8).Address & "))"), vbTab)
    Next
End With
With CreateObject("VBScript.RegExp")
    .Pattern = "[\f\n\r\v]"
    .Global = True
    txt = .Replace(txt, vbCrLf)
    .Pattern = "\n{2,}"
    txt = .Replace(txt, vbCrLf)
End With
Open fn For Output As #1
    Print #1, Mid$(txt, 2)
Close #1
End Sub

It now removes the "rectangle" from the left, but put's it above the value from K in the text file.

 

[jindon]

Are you opening the text file from text editor ?
Anyway change to

With CreateObject("VBScript.RegExp")
    .Pattern = "[\f\n\r\v]"
    .Global = True
    txt = .Replace(txt, vbCrLf)
    .Pattern = "\n{2,}"
    txt = .Replace(txt, vbCrLf)
    .Pattern = "^\n+"
    text = .Replace(txt,"")
End With

Eidted

 

[pbt]

I am opening the Text file from the Desktop once it it there.

Tried the latest code, still getting the charactor above the value from K (first row of Text file)

Second row down is good.

 

[jindon]

You mean when you open the text file from NotePad(Not from Excel), it looks something like

□
data1     data2     data3    data4
data1     data2     data3    data4
.
.

?