Writing to Output text file Tab Delimited

[Guest]

I'm using the write command in VBA within a module to write selected fields
to a Tab Delimited file. The code writes ok, but adds parenthesis to the
beginning and end of the line. I need to exclude these as the file I'm
uploading to won't accept the parenthesis. I've tried to use the Mid
function on the text line to remove them, but it removes the first and last
character in the text them puts the parenthesis around that.
Is there a way to write to an text file with including the parenthesis?
Thanks.

 

[TC]

The Write command does not enclose the output line in parentheses
AFAIK.

Show us the code you are using, an an actual exmple of what it
produces.

TC (MVP Access)
http://tc2.atspace.com

 

[Guest]

Public Sub ExportLBLUploadFile()

Dim db As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim DataString, HeaderString, strdata As String
Dim FileName As String
Dim HeadLine As String
Dim I, valcount As Long

FileName =
"G:\Sales\Licensing\Symantec\Tracking\BulkLoaderTracking\SymantecTracking.txt"

Set db = CurrentProject.Connection

rst.CursorLocation = 3

rst.Open "tblTracking", db

valcount = rst.RecordCount

Open FileName For Output As #1

For I = 1 To rst.RecordCount

If I = 1 Then
DataString = "Distributor PO" & Chr(9) & "Master Vendor Number"
& Chr(9) & "Authorization Number" & Chr(9) & "License Number" & Chr(9) &
"Ship Date" & Chr(9) & "Ship Via" & Chr(9) & "Tracking Number"
Else
DataString = rst.Fields("Distributor PO") & Chr(9) &
rst.Fields("Master Vendor Number") & Chr(9) & rst.Fields("Authorization
Number") & Chr(9) & rst.Fields("License Number") & Chr(9) & rst.Fields("Ship
Date") & Chr(9) & rst.Fields("ShipVia") & Chr(9) & rst.Fields("Tracking
Number")
End If

rst.MoveNext

Write #1, DataString


Next I

rst.Close

Close #1



End Sub

 

[TC]

Show me an actual example of what that code produces.

TC (MVP Access)
http://tc2.atspace.com

 

[Guest]

HI Dan, I wrote this a long long long time ago. Maybe you can use it if the
current system can't be fixed.

Scott Burke

Rem This function will save the tables to SDF format without "Hard Returns" at
Rem the end of each record.
Function save_Tape(thename As String, thetotal As Long, Thedate As Date,
thefile As String, DateType As String)
Dim db As Database
Dim rs As Recordset
Dim fld As Field

Dim work1 As String
Dim aa As String
Dim new_line As String
Dim disknum As Double
Dim i As Long
Dim MsgStr As String
Dim progMeter As Variant
Dim rec_count As Long

Set db = CurrentDb()
Set rs = db.OpenRecordset(thename)

Rem Check the drive for a disk.
Rem Check_drive

Rem Set up working varibles.
work1 = Space(1)
aa = Space(1)
new_line = Chr(13) & Chr(10)
disknum = 0
MsgStr = Space(1)

Rem Move to top of recordset
rs.MoveLast
rs.MoveFirst

Rem Setup the program meter!
rec_count = 1
progMeter = SysCmd(acSysCmdInitMeter, "Creating Tape ", rs.RecordCount)
DoCmd.Hourglass True

Rem Close any thing that maybe open in channel #1
Close #1

Rem Give the user the information they will need.
disknum = rs.RecordCount / thetotal
If Not disknum = Int(disknum) Then
disknum = Int(disknum) + 1
End If
MsgStr = "Creating Clearance Disk " & Trim(thefile) & new_line
MsgStr = MsgStr & new_line
MsgStr = MsgStr & "Clear Date : " & Format(Thedate) & new_line
MsgStr = MsgStr & new_line
MsgStr = MsgStr & "Total Records: " & Trim(str(rs.RecordCount)) & new_line
MsgStr = MsgStr & new_line
MsgStr = MsgStr & "You will need ( " & Trim(str(disknum)) & " ) Tape's for
this clearance."
aa = MsgBox(MsgStr, vbOKCancel, "Clearance Message")

Rem disknum =
Do While Not rs.EOF And aa = 1
Rem Open the work file in channel #1
work1 = Trim(thefile)

Rem kill the existing file.
If Len(Dir$(work1)) > 0 Then
Kill (work1)
End If
Open work1 For Append As #1

For i = 1 To thetotal
Rem Check for EOF
If Not rs.EOF Then
Rem lets do it!!!
work1 = Space(0)
For Each fld In rs.Fields
Rem To be 100% correct... You must check for all
Rem field types. However, My export files use
Rem TEXT and Date field types only.
If IsNull(fld.type) = dbdate Then
work1 = work1 & sizestr(fld.value, fld.Size)
Else
If fld.type = dbdate Then
work1 = work1 & sizedate(fld.value, DateType)
Else
work1 = work1 & sizestr(fld.value, fld.Size)
End If
End If
Next fld

Rem The print statment add's controll charaters at the end of
the string
Rem when it prints the string to the file. However, the ";"
stops that
Rem from happening.

work1 = mid(work1,1, len(work1) - 2)
Print #1, work1;

rs.MoveNext

Else
Rem If EOF is reached then end the loop.
i = thetotal
End If

Rem Update the program meter.
rec_count = rec_count + 1
progMeter = SysCmd(acSysCmdUpdateMeter, rec_count)
Next
Close #1

If Not rs.EOF Then
aa = MsgBox("Please put another Disk in Drive A:\", vbOKCancel,
"Save as SDF File")
Rem If Cancel was selected then quit. The loop is controled in half
by this value.
End If
Loop
Rem Clear the program meter.
progMeter = SysCmd(acSysCmdClearStatus)
DoCmd.Hourglass False
End Function