• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro to copy Data from Excel and creates Txt file with fixed length.

Status
Not open for further replies.

sesgiri

New Member
Hello,

Can any one of you please help me in solving my problem.

I need a Macro, which captures the data from Excel and writes in .txt file. I am missing something in my code..please check..

appreciate your help in advance.

Code:
Option Explicit

Sub EXPORTFallon()
Dim fPath As String
Dim fName As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False

fPath = "D:\Local Disk (D)\Temp"  'remember final \ in this string
fName = "FALLONGRPS.txt-" & Format(Date, "MM.DD.YYYY")

  Range("A2:S2").Copy
  Workbooks.Add
  Range("A2:S2").PasteSpecial xlPasteValuesAndNumberFormats
 
  Columns("A:A").ColumnWidth = 3
  Columns("B:B").ColumnWidth = 15
  Columns("C:C").ColumnWidth = 60
  Columns("D:D").ColumnWidth = 60
  Columns("E:E").ColumnWidth = 60
  Columns("F:F").ColumnWidth = 30
  Columns("G:G").ColumnWidth = 2
  Columns("H:H").ColumnWidth = 9
  Columns("I:I").ColumnWidth = 15
  Columns("J:J").ColumnWidth = 8
  Columns("K:K").ColumnWidth = 8
  Columns("L:L").ColumnWidth = 8
  Columns("M:M").ColumnWidth = 15
  Columns("N:N").ColumnWidth = 15
  Columns("O:O").ColumnWidth = 1
  Columns("P:P").ColumnWidth = 2
  Columns("Q:Q").ColumnWidth = 1
  Columns("R:R").ColumnWidth = 10
  Columns("S:S").ColumnWidth = 391
 
  'Rows(2).Insert xlShiftDown
  'Range("A2:S2").Value = [{"Record Type","Sponsor Number","Sponsor Name","Address1","Address2","City","State","Zip","Phone","Benefit Plan Eff Date","Effective Date","Term Date","Till R2"}]
 
  ActiveWorkbook.SaveAs Filename:=fPath & fName, FileFormat:=xlTextPrinter
  ActiveWorkbook.Close False
 
  Name fPath & fName As fPath & fName & ".dbf"

Application.ScreenUpdating = True
MsgBox "Done"
End Sub
 

Attachments

  • Importss.xlsx
    12.8 KB · Views: 15
Last edited by a moderator:
Hi,

respect forum rules : edit your post and use code tags !

The better the explanation is, the better the help will …
 
Pls check this.

First Check this then
http://chandoo.org/forum/threads/new-users-please-read.294/

Solution.

Code:
Option Explicit

Sub EXPORTFallon()
Dim fPath As String, fName As String, Rng As Range
Dim buf As String, col As Long, dRow As Long
Dim c As Range, ws As Worksheet, r As Long
Dim fNum As Single
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set ws = ActiveSheet
fPath = "C:\Users\Deepak\Desktop\"
fName = "FALLONGRPS-" & Format(Date, "MM.DD.YYYY")
fNum = FreeFile()
Open fPath & fName & ".txt" For Output As #fNum
With ws
    col = 19 '.UsedRange.Columns.Count
    dRow = 2 '.UsedRange.Rows.Count
        For r = 2 To dRow
            Set Rng = .Range(.Cells(r, 1), .Cells(r, col))
                For Each c In Rng
                    buf = buf & c.Text & "|"
                Next
                buf = Left(buf, Len(buf) - 1)
            Print #fNum, buf
        buf = ""
        Next r
End With
Close #fNum
Set Rng = Nothing
Set ws = Nothing
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
 
Pls check this.

First Check this then
http://chandoo.org/forum/threads/new-users-please-read.294/

Solution.

Code:
Option Explicit

Sub EXPORTFallon()
Dim fPath As String, fName As String, Rng As Range
Dim buf As String, col As Long, dRow As Long
Dim c As Range, ws As Worksheet, r As Long
Dim fNum As Single
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set ws = ActiveSheet
fPath = "C:\Users\Deepak\Desktop\"
fName = "FALLONGRPS-" & Format(Date, "MM.DD.YYYY")
fNum = FreeFile()
Open fPath & fName & ".txt" For Output As #fNum
With ws
    col = 19 '.UsedRange.Columns.Count
    dRow = 2 '.UsedRange.Rows.Count
        For r = 2 To dRow
            Set Rng = .Range(.Cells(r, 1), .Cells(r, col))
                For Each c In Rng
                    buf = buf & c.Text & "|"
                Next
                buf = Left(buf, Len(buf) - 1)
            Print #fNum, buf
        buf = ""
        Next r
End With
Close #fNum
Set Rng = Nothing
Set ws = Nothing
Application.ScreenUpdating = True
MsgBox "Done"
End Sub


Bro,

Thank you for your reply.This time I am looking for a Fixed length text file, not the delimit.thanks for your reply.

Best Regards.
 
Bro,

Thank you for your reply.This time I am looking for a Fixed length text file, not the delimit.thanks for your reply.

Best Regards.

Is this what looking you are!!

Code:
Sub Savetxt()
Dim fPath As String, fName As String, fn As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

fPath = "D:\Temp\" 'change
fName = "FALLONGRPS-" & Format(Date, "MM.DD.YYYY")
fn = fPath & fName & ".txt"

    ActiveSheet.Copy
    ActiveSheet.Rows(1).Delete
    ActiveWorkbook.SaveAs fn, xlText, CreateBackup:=False
    ActiveWindow.Close False
   
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done", vbInformation
End Sub
 
Dear All,

Thank you for extend support. Please find the attached code.

My Question: My code is not picking the trailer record.Can some please help me?

Thanks in advance,
Sesgiir
 

Attachments

  • Export-New.txt
    2 KB · Views: 6
  • Samplefile.txt
    2.1 KB · Views: 5
Status
Not open for further replies.
Back
Top