Create Text file from Excel (part 2)

[pbt]

This is a continuation of a project I'm working on and had help on:
http://www.mrexcel.com/forum/showthread.php?t=315241

Using my Old code that I am trying to modify with jindon's suggestions from the above link:

Old code:

Sub CopyToNewBook()
    Dim Response As Integer
    On Error Resume Next
    Response = MsgBox(Prompt:="This  procedure  will  export  the  payroll  SUMMARY" & vbCr & _
    "into a Tab Delimited Text File and save it to C:\Payroll" & vbCr & _
    "                        PROCEED", Buttons:=vbQuestion + vbYesNo, Title:="               FINAL STEP")
        If Response = vbNo Then
        Exit Sub
        End If
    Application.ScreenUpdating = False

    '//Copy the SUMMARY sheet to a new book (Text tab delimited).
    Sheets("SUMMARY").Copy
    '//Identify the path you wish to save to here.
    MkDir "C:\Payroll"
    ChDir "C:\Payroll"
    '//Save the export sheet as a new workbook named "Payroll"
    '//and the date that resides in the PAYCALC sheet cell B3
    '//Copy will be saved as tab delimited text.
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs "Payroll" & " " & _
    Format(Sheet1.Range("C4").Value, "mmm,dd,yy") & ".txt", _
        FileFormat:=xlText, CreateBackup:=False
    '//Close the copy and return to the original.
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    MsgBox Prompt:="Export of payroll information to a text file complete" & vbCr & _
    "The file may be found on your C drive in a folder named Payroll", _
    Title:="                    PROCEDURE SUCCESSFUL"
    
End Sub

Gives me a Text file as below:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K
1	LBZVB010.55.ST30	LS0145	6/7	7	1	*	468	72.57	STUCCO	5022	5/28
2	LBZVB010.55.ST30	LS0140	6/7	7	1	*	650	100.79	STUCCO	5022	5/28
3	LBZVB010.55.ST30	LS0372	6/7	7	1	*	600	93.04	STUCCO	5022	5/28
4	LBZVB010.55.ST30	LS0373	6/7	7	1	*	400	62.03	STUCCO	5022	5/28
Sheet1

With this modification to the above code using jindon's lead:

Sub CopyToTextFile()
    Dim Response As Integer
    On Error Resume Next
    Response = MsgBox(Prompt:="This  procedure  will  export  the  payroll  SUMMARY" & vbCr & _
    "into a Tab Delimited Text File and save it to your" & vbCr & "! DESKTOP !  with a Date and Time Stamp To The Second" & vbCr & _
    " " & vbCr & "                        PROCEED", Buttons:=vbQuestion + vbYesNo, Title:="               FINAL STEP")
        If Response = vbNo Then
        Exit Sub
        End If
    Application.ScreenUpdating = False

    '//Copy the SUMMARY sheet to a new book (Text tab delimited).
    fn = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
       "\Payroll Export(" & Format$(Now, "mmddyy-hh-mm-ss") & ").txt"
With Sheets("SUMMARY")
    For Each r In .Range("K1", .Range("K" & Rows.Count).End(xlUp))
        If r.Value <> 0 Then txt = txt & vbCrLf & Join(Evaluate("transpose(transpose(" & _
         r.Offset(, -10).Resize(, 11).Address & "))"), vbTab)
    Next
End With
Open fn For Output As #1
    Print #1, Mid$(txt, Len(vbCrLf) + 1)
Close #1
   
    Range("A1").Select
    Application.ScreenUpdating = True
    SplashForm.Show
   
    MsgBox Prompt:="Export of payroll information to a text file complete" & vbCr & _
    "The file may be found on your DESKTOP with a Time Stamp", _
    Title:="                    PROCEDURE SUCCESSFUL"
    
End Sub

I come up with this Text file:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K
8	LBZVB010.55.ST30	LS0145	39605	7	1	*	468	72.5696202531646	STUCCO	5022	39596
9	LBZVB010.55.ST30	LS0140	39605	7	1	*	650	100.7911392405060	STUCCO	5022	39596
10	LBZVB010.55.ST30	LS0372	39605	7	1	*	600	93.0379746835443	STUCCO	5022	39596
11	LBZVB010.55.ST30	LS0373	39605	7	1	*	400	62.0253164556962	STUCCO	5022	39596
Sheet1

As you can see Col C & K come up with date serial numbers and Col H comes up with 13 didgits to the right of the decimal.

I am running both macros from the same Workbook (for testing purposes). Cols C & K are formatted as Custom > m/d, and Col H is formated as Number > 2 decimal places.

I am lost on how to make second macro produce the results that the first one did in the Text file.

Harry

 

[pbt]

Thought this comment might shed some light:

On the SUMMARY sheet, Col's C & K do show date format as 6/7/2008 in the Formula bar, and Col H does show 13 places to the right in the Formula bar.

Harry

 

[jindon]

Harry
Change

With Sheets("SUMMARY")
    For Each r In .Range("K1", .Range("K" & Rows.Count).End(xlUp))
        If r.Value <> 0 Then txt = txt & vbCrLf & Join(Evaluate("transpose(transpose(" & _
         r.Offset(, -10).Resize(, 11).Address & "))"), vbTab)
    Next
End With

to

With Sheets("SUMMARY")
    With .Range("A1", .Range("K" & Rows.Count).End(xlUp))
        For i = 1 To .Rows.Count
            For Each r In .Rows(i).Cells
                temp = temp & vbTab & r.Text
            Next
            txt = txt & vbCrLf & temp
            temp = ""
        Next
    End With
End With

 

[pbt]

Thank you jindon

The posted fix did the job, but the info on the Text file starts in col 2.

It should be in Col 1.

Harry

 

[jindon]

OOps
change to

txt = txt & vbCrLf & Mid$(temp, Len(vbTab) + 1)

 

[pbt]

Thank you jindon, I really appreciate the Help that you have given me.

All is fine, works great. (You are the Man)
________________________________________________________________
Unrelated Question: With a MsgBox, is it possible to make certain lines Bold?
(seems like I read something that it can't be done, just want verification)

Example: With my last MsgBox, can I make "DESKTOP" bold.

I know that this is a start of another Thread, but if the answer is No, then there will be no other thread.

Harry

 

[jindon]

If you search the forum, you might get some codes with API functions, but I would create a UserForm instead and it is much easier.

 

[pbt]

Thank you for the insight on that.

I will experiment with it and see what I come up with.

Harry