Da li je ovo rešenje?
Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameW" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameW" (ByRef pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Dim sString As String
Private opFile As OPENFILENAME
Private fso As FileSystemObject
Private Function ShowOpenUnicode() As String
With opFile
.flags = &H2 Or &H4
.hInstance = App.hInstance
.hWndOwner = Me.hWnd
.lpstrFilter = StrConv(("Text Files" & Chr(0) & "*.txt" & Chr(0) & Chr(0)), vbUnicode)
.lpstrTitle = StrConv("Open File", vbUnicode)
.lpstrFile = StrConv(String(256, Chr(0)), vbUnicode)
.nMaxFile = 512
.lStructSize = Len(opFile)
End With
Call GetOpenFileName(opFile)
ShowOpenUnicode = opFile.lpstrFile
End Function
Private Function ShowSaveUnicode() As String
With opFile
.flags = &H2 Or &H4
.hInstance = App.hInstance
.hWndOwner = Me.hWnd
.lpstrFilter = StrConv(("Text Files" & Chr(0) & "*.txt" & Chr(0) & Chr(0)), vbUnicode)
.lpstrTitle = StrConv("Save File", vbUnicode)
.nMaxFile = 512
.lpstrFile = sString & String(512 - Len(sString), Chr(0))
.lStructSize = Len(opFile)
End With
Call GetSaveFileName(opFile)
ShowSaveUnicode = opFile.lpstrFile
End Function
Private Function ConvertFileName(sToConvert) As String
Dim bFileName() As Byte
Dim lRet As Long
Dim sBuf As String
'Get rid of the trailing Null characters
sToConvert = Left$(sToConvert, InStr(sToConvert, (Chr(0) & Chr(0))) - 1)
If Len(sToConvert) Mod 2 <> 0 Then
sToConvert = sToConvert & Chr(0) 'If the file has an ANSI extension or just an ANSI last character of
'a file with no extension, add one on the end
'If we don't add it, the string will end one character too short
End If
bFileName = StrConv(sToConvert, vbFromUnicode) 'Put the string into a byte array
sBuf = ""
For lRet = 0 To Len(sToConvert) - 1 Step 2
'At this point, the unicode characters will show up in sBuf as ?, but, when we actually go
'to use this in the FSO function, it will find the right file
sBuf = sBuf & StrConv(Chr(bFileName(lRet)) & Chr(bFileName(lRet + 1)), vbFromUnicode)
Next
'And return the string for use
ConvertFileName = sBuf
End Function
Private Sub UnicodeSaveMethod()
Dim sFileName As String
'Show the save dialog and get the file path as Unicode in a VB String
sFileName = ShowSaveUnicode
If Left$(sFileName, 1) = Chr(0) Then Exit Sub 'Exit on Cancel
'Convert the file name to be used
sFileName = ConvertFileName(sFileName)
'Here is where you'd create the file, input the text, and save it
'For this example, I just try to create the file
Call fso.CreateTextFile(sFileName, False)
End Sub
Private Sub UnicodeOpenMethod()
Dim sFileName As String
'Show the open dialog and get the file path as Unicode in a VB String
sFileName = ShowOpenUnicode
If Left$(sFileName, 1) = Chr(0) Then Exit Sub 'Exit on Cancel
'Convert the file name to be used
sFileName = ConvertFileName(sFileName)
'This line will print everything in the file to show you it works
'Otherwise, you'd have normal open/read/etc code here
Debug.Print fso.OpenTextFile(sFileName, ForReading, False).ReadAll
End Sub
Private Sub Form_Load()
Set fso = New FileSystemObject
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set fso = Nothing
End Sub
Private Sub Command1_Click()
UnicodeOpenMethod
End Sub
Private Sub Command2_Click()
UnicodeSaveMethod
End Sub
Kako preimenovati unicode file cirilica u latinicu
29.01.2016. u 17:22 · pre 130 meseci
#1
