Question

我想使用VBA创建一个文件，但有以下三个要求。

文件内容为unicode
文件名为unicode
我想附加到现有文件（如果文件存在，否则创建它）

我在这里提供两个代码摘录。第一个提取物将做1和2.第二个提取物将做1和3.但是我无法弄清楚如何做1,2和3。

我可以使用GSerg在How can I create text files with special characters in their filenames中的答案中的以下代码来创建带有unicode内容的unicode文件名

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

我可以使用以下代码附加到具有unicode内容的非unicode fillename

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

如何使用Unicode内容将追加的代码提取（或其他内容）改编为Unicode文件名？

（我读过关于代码的第一个提取使用SetFilePointer，但我无法使其工作）

更新

问题可能在于aFile变量的填充。（谢谢@ChipsLetten）我填写如下

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

使用VBA

0 个答案: