0

I want to create a file using VBA, but have the following three requirements.

  1. The file contents are unicode
  2. The filename is unicode
  3. I want to append to an existing file (if the file exists, otherwise to create it)

I present here two extracts of code. The first extract will do 1 and 2. The second extract will do 1 and 3. However I can't figure out how to do 1, 2 and 3.

I can use the following code from GSerg's answer in How can I create text files with special characters in their filenames to create a unicode filename with unicode contents

Private Declare Function CreateFileW Lib "kernel32.dll" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByRef lpOverlapped As Any) As Long

Private Const CREATE_ALWAYS As Long = 2
Private Const OPEN_ALWAYS As Long = 4
Private Const GENERIC_WRITE As Long = &H40000000
Sub writeLine(aFile As String, val As String)
Dim hFile As Long
hFile = CreateFileW(StrPtr(aFile), GENERIC_WRITE, 0, ByVal 0&, OPEN_ALWAYS, 0, 0)

WriteFile hFile, &HFEFF, 2, 0, ByVal 0&  'Unicode byte order mark (not required, but to please Notepad)
WriteFile hFile, ByVal StrPtr(val), Len(val) * 2, 0, ByVal 0&

CloseHandle hFile
End Sub

I can use the following code to append to a non-unicode fillename with unicode contents

Sub AddToFile(ByVal aFile As String, ByVal aLine As String)
Dim myFSO2 As New Scripting.FileSystemObject
Dim ts2 As TextStream
    Set ts2 = myFSO2.OpenTextFile(aFile, ForAppending, True, TristateTrue)

ts2.Write aLine & vbNewLine
ts2.Close

End Sub

How can I adapt either extract of code (or do something else) to append to a Unicode filename with Unicode contents?

(I read about using SetFilePointer with regard to the first extract of code but I couldn't get it to work)

UPDATE

The problem probably lies with the population of the aFile variable. (Thanks @ChipsLetten) I populate it as follows

Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(fileToOpen)


For Each para In WordDoc.Paragraphs    
    If para.Style.NameLocal = "Style1" Then
    aFile= para.Range.Text
Community
  • 1
  • 1
gordon613
  • 2,770
  • 12
  • 52
  • 81
  • I've just tried a version of your AddToFile proc to append "Hello αβθ you" to the file "C:\simonl\Hello αβθ you.txt" and it seems to work ok. Both text values are got from a cell. Is there maybe an issue with how your `aFile` variable gets populated? – ChipsLetten Jul 30 '15 at 19:15
  • Agreed! But the problem with AddToFile is that it won't create the *filename* for unicode (as I write above) - the appending it does do! – gordon613 Jul 30 '15 at 20:43
  • The `AddToFile` code seems to create a filename in unicode and write to it on my machine. So don't think I can help any further. FWIW: You might want to use `ts2.WriteLine aLine` rather than appending `vbNewLine`. – ChipsLetten Jul 31 '15 at 10:51
  • Hi @ChipsLetten - I think you're right - that the problem is with the population of `aFile` variable. I have updated my question accordingly. – gordon613 Jul 31 '15 at 12:32

0 Answers0