View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Sean McPoland[_2_] Sean McPoland[_2_] is offline
external usenet poster
 
Posts: 2
Default CreateTextFile not updating file

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