CreateTextFile not updating file

[Sean McPoland]

Hi,

I have a simple piece of code as below reading from
database and updating a textstream file.

Only trouble is it does not want to update the file....

The macro runs successfully but when doing the ts.close,
where you think the file will be closed and Windows
properties (date time etc) for the file will be updated -
but no the file is NOT being updated at all; and there
are NO error messages (i.e. file in use etc)

if anyone can shead any light I would be grateful,
regards
Sean

Code Below:

Option Explicit
Sub main()

Dim conn As ADODB.Connection
Dim conS As String

Dim rsData As ADODB.Recordset
Dim rsDataS As String

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1,
TristateFalse = 0
Dim fs, f, ts, s

conS = "Provider=SQLOLEDB;" & _
"Data Source=111.111.111.111;" & _
"Initial Catalog=QWERTYmaindatabase;" & _
"User Id=????;" & _
"Password=????????"

Set conn = New ADODB.Connection
Set rsData = New ADODB.Recordset

conn.Open conS

rsDataS = "SELECT [year], [month], [day] " & _
"FROM [QWERTY] " & _
"where Status = 1 " & _
"and operatorcode = 1 " & _
"and routecode = 2 " & _
"and cast([year] as varchar(4)) + '/' + cast([month]
as varchar(4)) + '/' + cast([day] as varchar(4)) > getdate
() " & _
"order by year asc, month asc, day asc "

rsData.Open rsDataS, conn

Cells.Select
Selection.Clear

Set fs = CreateObject("Scripting.FileSystemObject")
fs.CreateTextFile "ETCFCDateStrings.txt" 'Creat
e a file
Set f = fs.GetFile("ETCFCDateStrings.txt")
Set ts = f.OpenAsTextStream(ForWriting,
TristateUseDefault)


Range("A1").Select

If Not rsData.EOF Then

Dim rsField As ADODB.Field
Dim lOffset As Integer

With Range("A1")
For Each rsField In rsData.Fields
.Offset(0, lOffset).Value = rsField.Name
lOffset = lOffset + 1
Next rsField
End With

Dim i As Integer
i = 2
Do While Not rsData.EOF

Range("a" & i).Value = rsData.Fields(0).Value
Range("b" & i).Value = rsData.Fields(1).Value
Range("c" & i).Value = rsData.Fields(2).Value
Range("g" & i).Value = "<option value=" & Range
("c" & i).Value & "/" & Range("b" & i).Value & "/" & Range
("a" & i).Value & ">" & Range("c" & i).Value & "/" & Range
("b" & i).Value & "/" & Range("a" & i).Value & "</option>"
ts.Write Range("g" & i).Value & vbCrLf

i = i + 1
rsData.MoveNext

Loop

Else
End If

If CBool(conn.State And adStateOpen) Then
conn.Close
Else
End If

Set conn = Nothing
ts.Close
ActiveWorkbook.Save
Application.Quit

End Sub

 

[Dick Kusleika]

Sean

I took out all the ado stuff and reduced it to this

Sub main()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim fs, f, ts, s

Set fs = CreateObject("Scripting.FileSystemObject")
fs.CreateTextFile "ETCFCDateStrings.txt" 'Create a file
Set f = fs.GetFile("ETCFCDateStrings.txt")
Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)

For s = 1 To 5
ts.Write "This is a test"
Next s

ts.Close

End Sub

And it worked fine. I can't imagine that the ado stuff had an effect on it.
Are you sure your recordset is returning something. Maybe you're just
writing blank fields to your textfile. Maybe you need a MoveFirst before
you start looping through the recordset. I assume you know what's happening
with the recordset by what gets written to the spreadsheet, but it's all I
can think that might be a problem.

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

Hi,

I have a simple piece of code as below reading from
database and updating a textstream file.

Only trouble is it does not want to update the file....

The macro runs successfully but when doing the ts.close,
where you think the file will be closed and Windows
properties (date time etc) for the file will be updated -
but no the file is NOT being updated at all; and there
are NO error messages (i.e. file in use etc)

if anyone can shead any light I would be grateful,
regards
Sean

Code Below:

Option Explicit
Sub main()

Dim conn As ADODB.Connection
Dim conS As String

Dim rsData As ADODB.Recordset
Dim rsDataS As String

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1,
TristateFalse = 0
Dim fs, f, ts, s

conS = "Provider=SQLOLEDB;" & _
"Data Source=111.111.111.111;" & _
"Initial Catalog=QWERTYmaindatabase;" & _
"User Id=????;" & _
"Password=????????"

Set conn = New ADODB.Connection
Set rsData = New ADODB.Recordset

conn.Open conS

rsDataS = "SELECT [year], [month], [day] " & _
"FROM [QWERTY] " & _
"where Status = 1 " & _
"and operatorcode = 1 " & _
"and routecode = 2 " & _
"and cast([year] as varchar(4)) + '/' + cast([month]
as varchar(4)) + '/' + cast([day] as varchar(4)) > getdate
() " & _
"order by year asc, month asc, day asc "

rsData.Open rsDataS, conn

Cells.Select
Selection.Clear

Set fs = CreateObject("Scripting.FileSystemObject")
fs.CreateTextFile "ETCFCDateStrings.txt" 'Creat
e a file
Set f = fs.GetFile("ETCFCDateStrings.txt")
Set ts = f.OpenAsTextStream(ForWriting,
TristateUseDefault)


Range("A1").Select

If Not rsData.EOF Then

Dim rsField As ADODB.Field
Dim lOffset As Integer

With Range("A1")
For Each rsField In rsData.Fields
.Offset(0, lOffset).Value = rsField.Name
lOffset = lOffset + 1
Next rsField
End With

Dim i As Integer
i = 2
Do While Not rsData.EOF

Range("a" & i).Value = rsData.Fields(0).Value
Range("b" & i).Value = rsData.Fields(1).Value
Range("c" & i).Value = rsData.Fields(2).Value
Range("g" & i).Value = "<option value=" & Range
("c" & i).Value & "/" & Range("b" & i).Value & "/" & Range
("a" & i).Value & ">" & Range("c" & i).Value & "/" & Range
("b" & i).Value & "/" & Range("a" & i).Value & "</option>"
ts.Write Range("g" & i).Value & vbCrLf

i = i + 1
rsData.MoveNext

Loop

Else
End If

If CBool(conn.State And adStateOpen) Then
conn.Close
Else
End If

Set conn = Nothing
ts.Close
ActiveWorkbook.Save
Application.Quit

End Sub