Write to text file question

[vzachin]

hi,

i have a simple script that writes to a notepad file. if the file is already open, i don't see any updates unless i close the file and reopen it.
is there a way to check to see if the file is open, then close it and reopen it?



[VBA]Sub Test()
On Error Resume Next
Open "C:\testOpen.txt" For Append As 1
dat = Range("a1")
Print #1, dat
Close #1
End Sub[/VBA]

thanks
zach

[Bob Phillips]

You can test for it being open with

[vba]


Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long

On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0

Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select

End Function
[/vba]

but I don't think you can close it unless you have it open.

[vzachin]

bob,

i'm a little dense. i don't understand how to evoke the function correctly.
can you please explain? if the file is open, how would i close it and then reopen it?

thanks
zach

[GTO]

... notepad file. if the file is already open, i don't see any updates unless i close the file and reopen it.


is there a way to check to see if the file is open, then close it and reopen it?

Hi Zach,

Just for my clarity, when you say "...if the file is already open, I don't see any updates..." are your referring to whether the file is Open for I/O, or are you talking about if you already have the file opened in Notepad (ie - yo uare viewing the file)?

Mark

[Bob Phillips]

bob,

i'm a little dense. i don't understand how to evoke the function correctly.
can you please explain? if the file is open, how would i close it and then reopen it?

thanks
zach

You would just call that function with the full filename of the file you wish to open to get a true or false result as to whether it is open or not.

As I said earlier, unless you have the file open, you can't close it from VBA.

[GTO]

@XLD:

Would you mind a PM?

Mark

[Bob Phillips]

No, I don't see that as a problem.

[vzachin]

Hi Zach,

Just for my clarity, when you say "...if the file is already open, I don't see any updates..." are your referring to whether the file is Open for I/O, or are you talking about if you already have the file opened in Notepad (ie - yo uare viewing the file)?

Mark

hi mark,

if i'm viewing the Notepad file, i would not see any "updates", so i would have to quit the Notepad and re-open it to see the "updates"

zach

[GTO]

Hi Zack,

I am afraid you are correct. I don't know how to explain this better, but in essence, a text editor like notepad works a bit different than let's say, Excel.

Even though the actual file on the drive has been overwritten, the window you are looking at doesn't refresh.

I hope that makes at least a bit of sense, but if not, try this:

Open your textfile in notepad.

Run the code.

open the textfile again thru WIN Explorer (this will give you another copy nof notepad. This copy will show the val from A1 appended.

And if you want to see something 'bizarrer' , now Save in the notepad copy that didn't have the val updated and close all notepads...

reopen the txt file and the added val is gone.

Again, others could explain this in a more articulate fashion,

Mark

[vzachin]

hi bob

this is what i tried but i'm getting an error: "Run-time error '54': Bad file mode

[vba]Sub Test()
FileName = IsFileOpen("C:\testOpen.txt")
End Sub
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long

On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum

dat = Range("a1")
Print #1, dat
Close iFilenum

iErr = Err
On Error GoTo 0

Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select

End Function[/vba]

if i change [vba]
Open FileName For Input Lock Read As #iFilenum
[/vba]
to
[vba]
Open FileName For Append Lock Read As #iFilenum
[/vba] there is no error, but it always goes to Case 0: IsFileOpen = False

so what am i doing wrong?

zach

[vzachin]

i came up with the following which works for me.

[vba]Sub Final()
IDFile = "C:\\testOpen.txt"
Open IDFile For Append As #1
MyArea = Range("a1")
Print #1, MyArea
Close #1
Application.Wait (Now + TimeValue("0:00:01"))
On Error GoTo handler
AppActivate ("testOpen.txt - NotePad")
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "%FX"
Application.Wait (Now + TimeValue("0:00:01"))
Shell ("Notepad c:\testOpen.txt") '<---the file is minimized, how can i get it be be maximized
Exit Sub
handler:
Exit Sub
End Sub[/vba]

how can i get the file to be maximized?

thanks
zach

[GTO]

This should do the trick.
[vba]
Shell "Notepad C:\testOpen.txt", vbNormalFocus
[/vba]

Mark

[Kenneth Hobs]

[VBA]Shell "Notepad c:\testOpen.txt", vbMaximizedFocus
[/VBA]

[Kenneth Hobs]

I would not recommend using SendKeys() when you don't have to. SendKeys() will not work in Vista if you have UAC enabled. If you are going to use SendKeys() you could make a routine like I did where it writes to a closed file or the open file in Notepad. For that method, use the dataobject in Microsoft Forms 2.0 Object Library using the PutInClipboard and SetText methods. For tips using this method, see Chip Pearson's website: http://www.cpearson.com/excel/clipboard.htm. You could then send Ctrl+Ins to paste to Notepad.

Something like this might be a bit better. You can put the API routines, Constants and Function in a separate module if you like. I added a few more APIs and Constants that you can delete if needed as they are not needed.

You will need to change the path to an existing text file in the fn variable assignment for the two test routines. Before trying the first test, close your text file if it is open. For the second test, open your text file in Notepad and then play it. Notice that the same routine is used to append text to either a closed file or an open file in Notepad.

I did not address the case where more than one file with the same text file is open in Notepad or another user has the file open.

[VBA]Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As String) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, _
ByVal lpszClassName As String, ByVal lpszWindowCaption As String) As Long

Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long

Private Declare Function GetWindow Lib "user32" _
(ByVal hWnd As Long, ByVal wCmd As Long) As Long

Private Const WM_KEYDOWN = &H100
Private Const WM_SETTEXT = &HC
Private Const WM_CLOSE = &H10
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_CONTROL = &H11
Private Const WM_END = &H23
Private Const GW_CHILD = 5
Private Const EM_REPLACESEL = &HC2
Private Const EM_SETSEL = &HB1
Private Const EM_SETMODIFY = &HB9
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2

Private Declare Function RedrawWindow Lib "user32" _
(ByVal hWnd As Long, lprcUpdate As Any, ByVal hrgnUpdate As Long, _
ByVal fuRedraw As Long) As Long

Private Declare Function UpdateWindow Lib "user32" _
(ByVal hWnd As Long) As Long

Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long

Public Const RDW_INVALIDATE = &H1
Public Const WM_SETREDRAW = 11

'Test scenario when fn is not open.
Sub Test1_AppendTextToNotepad()
Dim fn As String, rc As Long
fn = "w:\ken.txt"

'Exit if fn does not exist
If Dir(fn) = "" Then Exit Sub

'Append text to fn with the file closed
AppendTextToNotepad "Hello World!", fn

'Open fn in Notepad
Shell "notepad " & """" & fn & """", vbNormalFocus
End Sub

'Test scenario when fn is open in Notepad.
Sub Test2_AppendTextToNotepad()
Dim fn As String, rc As Long
fn = "w:\ken.txt"

'Open our fn file in Wordpad if it exists
If Dir(fn) = "" Then Exit Sub
Shell "notepad " & """" & fn & """", vbNormalFocus

'Append text to fn with the file open in Notepad.
AppendTextToNotepad vbCrLf & "Hello World!" & vbCrLf, fn
End Sub

Sub AppendTextToNotepad(txt As String, theFilename As String)
Dim rc As Long, hWnd As Long, chWnd As Long, tl As Long, cs As String, tf As Boolean
hWnd = FindWindow(vbNullString, Dir(theFilename) & " - Notepad")
If hWnd = 0 Then
'Append some text to closed theFilename
AppendToFile theFilename, txt
Else
'Sets the Windows Caption, Title
'SendMessageStr hWnd, WM_SETTEXT, 0, "Ken's AppendTextToNotepad Example"

'Set the txt in the edit window of Notepad. All text is cut and then added with new text.
chWnd = FindWindowEx(hWnd, 0&, "Edit", vbNullString)

'Append txt to end
tf = WriteTextNotepad(hWnd, txt, 1) '1=Add to end
End If
End Sub

'HWnd specified in Notepad, add the specified character. No newline.
'IPos = 0: the current cursor position
'-1: Top
'1: last
Public Function WriteTextNotepad(hWnd As Long, strText As String, _
Optional iPos As Long = 0) As Boolean
Dim i As Long
i = GetWindow(hWnd, GW_CHILD)
Select Case iPos
Case -1
SendMessage i, EM_SETSEL, 0, 0
Case 1
SendMessage i, EM_SETSEL, 0, -1 'select all
SendMessage i, EM_SETSEL, -1, 0 'Deselect (move the cursor to the end of the selected area)
End Select
WriteTextNotepad = (0 <> SendMessageStr(i, EM_REPLACESEL, 0, strText))
End Function[/VBA]

[vzachin]

hi Ken,

i'm trying to follow your code and am getting a
"compile error: sub or function not defined" where it says "AppendToFile". how do i correct this?

[vba]Sub AppendTextToNotepad(txt As String, theFilename As String)
Dim rc As Long, hWnd As Long, chWnd As Long, tl As Long, cs As String, tf As Boolean
hWnd = FindWindow(vbNullString, Dir(theFilename) & " - Notepad")
If hWnd = 0 Then
'Append some text to closed theFilename
AppendToFile theFilename, txt 'getting error here
Else
'Sets the Windows Caption, Title
'SendMessageStr hWnd, WM_SETTEXT, 0, "Ken's AppendTextToNotepad Example"

'Set the txt in the edit window of Notepad. All text is cut and then added with new text.
chWnd = FindWindowEx(hWnd, 0&, "Edit", vbNullString)

'Append txt to end
tf = WriteTextNotepad(hWnd, txt, 1) '1=Add to end
End If
End Sub[/vba]

thanks

zach

[Kenneth Hobs]

If you put parts in separate Modules, you will need to change the word(s) Private to Public for the API routines. The Constants typically don't need to be Public.