Нет проблем Вот код, который открывает стандартное диалоговое окно | Код |
'Ссылка на стандартную функцию
'Вызывает диалоговое окно выбора файла для открытия
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
'Вызывает диалоговое окно выбора файла для сохранения
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (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
'Функция вызывает стандартное диалоговое окно на открытие файла _
strFilter - строка списка расширений
Public Function OpenDlg(strFilter As String, Optional iSelIndex As Integer = 1) As String
On Error GoTo ErHand
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = 0
OpenFile.hInstance = 0
sFilter = strFilter
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
'OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = "Открыть"
OpenFile.flags = 0
'Показать диалог
lReturn = GetOpenFileName(OpenFile)
If lReturn <> 0 Then
OpenDlg = OpenFile.lpstrFile
iSelIndex = OpenFile.nFilterIndex
End If
Exit Function
ErHand:
MsgBox "Невозможно открыть файл!", vbCritical + vbOKOnly, "Ошибка"
End Function
'Функция вызывает стандартное диалоговое окно на сохранение файла _
strFilter - строка списка расширений
Public Function SaveDlg(strFilter) As String
On Error GoTo ErHand
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = 0
OpenFile.hInstance = 0
sFilter = strFilter
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
'OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = "Сохранить"
OpenFile.flags = 0
'Показать диалог
lReturn = GetSaveFileName(OpenFile)
If lReturn <> 0 Then
SaveDlg = OpenFile.lpstrFile
End If
Exit Function
ErHand:
MsgBox "Невозможно открыть файл!", vbCritical + vbOKOnly, "Ошибка"
End Function
|
Вот код, который открывает файл bTypeCodine - кодировка | Код |
'///////////////////////////////////////////////////////////
'Открываю файл и загружаю даные во временный массив
Public Function OpenMyFile(ByRef sNameFile As String, sText, Optional bTypeCoding As Boolean = True) As Boolean
On Error GoTo ErHand
iNumbFile = FreeFile
Open sNameFile For Input Access Read Lock Write As #iNumbFile
'Загружаем файл
Dim I As Integer
Dim sTemp As String
I = 1
Do Until EOF(iNumbFile)
ReDim Preserve sText(I)
Line Input #iNumbFile, sTemp
If (sTemp <> "") Then
If bTypeCoding Then
sText(I) = ConvertDosToWin(sTemp)
Else
sText(I) = sTemp
End If
I = I + 1
End If
Loop
Close iNumbFile
OpenMylFile = True
Exit Function
ErHand:
' MsgBox "Ошибка при считывании файла!" & Chr(13) & sNameFile, vbOKOnly, "Ошибка"
OpenMyFile = False
Exit Function
End Function
|
А вот и функции с кодировками: | Код |
'Преобразование кодировки MS DOS в кодировку Windows
Function ConvertDosToWin(sInp As String) As String
Dim sWin As String
sWin = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдеёжзийклмнопрстуфхцчшщъыьэюя "
Dim sDos As String
sDos = "Ђ?‚ѓ„…р†‡?‰Љ‹Њ?Ћ??‘’“”•–—?™љ›њ?ћџ ЎўЈ¤Ґс¦§Ё©Є«¬®Їабвгдежзийклмноп "
Dim I As Integer
I = 1
Dim iPos As Integer
Dim sOut As String
Dim sChar As String
Do While I <= Len(sInp)
'Ищем позицию такого же символа в кодеровке MS DOS
sChar = Mid$(sInp, I, 1)
iPos = InStr(1, sDos, sChar)
If iPos > 0 Then
sOut = sOut + Mid$(sWin, iPos, 1)
Else
sOut = sOut + Mid$(sInp, I, 1)
End If
I = I + 1
Loop
ConvertDosToWin = sOut
End Function
'Преобразование кодировки Widows в MS DOS
Function ConvertWinToDos(sInp As String) As String
Dim sWin As String
sWin = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдеёжзийклмнопрстуфхцчшщъыьэюя "
Dim sDos As String
sDos = "Ђ?‚ѓ„…р†‡?‰Љ‹Њ?Ћ??‘’“”•–—?™љ›њ?ћџ ЎўЈ¤Ґс¦§Ё©Є«¬®Їабвгдежзийклмноп "
Dim I As Integer
I = 1
Dim iPos As Integer
Dim sOut As String
Dim sChar As String
Do While I <= Len(sInp)
'Ищем позицию такого же символа в кодеровке Windows
sChar = Mid$(sInp, I, 1)
iPos = InStr(1, sWin, sChar)
If iPos > 0 Then
sOut = sOut + Mid$(sDos, iPos, 1)
Else
sOut = sOut + Mid$(sInp, I, 1)
End If
I = I + 1
Loop
ConvertWinToDos = sOut
End Function
|
Вот и все. Берешь и делаешь :-) Это сообщение отредактировал(а) valex13 - 1.4.2005, 08:50 |
чтение файла в DOS кодировке в EXCEL, нужен макрос для чтения файла на VBA 
Загрузка ...
