ReSQL.ru
     
powered by simpleCommunicator - 2.0.55     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Вывод в файл в UTF-8
6 сообщений из 6, страница 1 из 1
Вывод в файл в UTF-8
    #39191465
Alex Pancho
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Alex Pancho
Гость
В базе используется текст в кодировке UTF-8.
Надо вывести результат запроса в файл, но текст в УТФ отображает знаками вопроса.
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
Private Sub button01_Click()
    'delete old filedata
    Call ClearTablesRef
    'link new file
    Call LinkSchema
    '
End Sub


Function LinkSchema()
   Dim db As Database, tbl As TableDef, filename As String, rst As Recordset, arr()
      Set db = CurrentDb()
   Set tbl = db.CreateTableDef("SourceData")
   ' Append selection of any file through a dialog box
   filename = "Asci.txt"
   Call SchemaIniCreate(filename)
   ' Connect to the data source file
   tbl.Connect = "Text;DATABASE=" & CurrentProject.Path & ";TABLE=" & filename & ""
   tbl.SourceTableName = filename
With db.TableDefs
    .Append tbl
    .Refresh
End With
    ' Find error in file
    strSql = "SELECT SourceData.pid, SourceData.Sname, SourceData.Fname, SourceData.fday " & _
    "FROM SourceData GROUP BY SourceData.pid, SourceData.Sname, SourceData.Fname, SourceData.fday " & _
    "HAVING ((Count(*) Mod 2)=1)"
    
    Set rst = db.OpenRecordset(strSql)
        If rst.RecordCount > 0 Then
           Call ErrLogCreate(funMsgListRecord(strSql))
           Call MsgBox("Import with errors!", vbCritical, "ERRORS!")
         
    End If
    
    
  
End Function

' Create schema.ini for .csv or .txt file
' If the column names, number of columns, or type columns of data will be changed - edit this part of the code.
Function SchemaIniCreate(filename As String)
    Dim create_file_name As String
    create_file_name = CurrentProject.Path & "\schema.ini"
    Open create_file_name For Output As #1
    Print #1, "[" & filename & "]"
    Print #1, "Format = Delimited(;)" 'IN USE. Use only one!
    'Print #1, "Format = Delimited(,)" 'Use only one!
    Print #1, "MaxScanRows = 0"
    Print #1, "ColNameHeader = False"
    Print #1, "CharacterSet = 65001"
    Print #1, "DecimalSymbol = ."
    Print #1, "CurrencyDecimalSymbol = ."
    Print #1, "Col1=""ouid"" Long Width 10"
    Print #1, "Col2=""did"" Long Width 10"
    Print #1, "Col3=""pid"" Long Width 10"
    Print #1, "Col4=""fday"" DateTime Width 30"
    Print #1, "Col5=""ftime"" DateTime Width 30"
    Print #1, "Col6=""punch"" Byte Width 3"
    Print #1, "Col7=""Sname"" Char Width 100"
    Print #1, "Col8=""Fname"" Char Width 100"
    Close #1
End Function

' Create Error Description
Function funMsgListRecord(ByVal sSQL As String)
Dim rst As DAO.Recordset
Dim sListMsg As String
Dim Output As String

On Error GoTo Err_
    Set rst = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
    With rst
        If Not (.BOF And .EOF) Then
            .MoveLast
            .MoveFirst
            Do Until .EOF
                If sListMsg = "" Then
                    Output = "id:" & !PID & ", Name: " & !Sname & " " & !fname & ", Date:" & !fDay & ""
                    sListMsg = Output
                Else
                    Output = "id:" & !PID & ", Name: " & !Sname & " " & !fname & ", Date:" & !fDay & ""
                    sListMsg = sListMsg & "</p><p>" & vbCrLf & Output
                End If
                .MoveNext
            Loop
        End If
        .Close
    End With
    Set rst = Nothing
    funMsgListRecord = sListMsg
Exit Function

Err_:
    MsgBox Err.Description
    Err.Clear
End Function


' Create errorlog.html if .csv or .txt contain error
Function ErrLogCreate(errmsg As String)
    Dim errorlog As String
    errorlog = CurrentProject.Path & "\errorlog.html"
    Open errorlog For Output As #2
    Print #2, "<!DOCTYPE html><html><head><meta charset=""utf-8""><title>Error log</title><body>"
    Print #2, "<h1>Errors in the import file:</h1>"
    Print #2, "<h2>" & errmsg & "</h2>"
    Print #2, "</body></html>"
    Close #2
End Function



В errorlog.html имена юзеров из базы выводит так: ????? ?????
...
Рейтинг: 0 / 0
14.03.2016, 15:15
| Ответить | Цитировать | Написать  
Вывод в файл в UTF-8
    #39191493
Фотография Konst_One
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Konst_One
Участник
используйте ADODB.Stream с указанием кодовой страницы в output
...
Рейтинг: 0 / 0
14.03.2016, 15:38
| Ответить | Цитировать | Написать  
Вывод в файл в UTF-8
    #39191548
Alex Pancho
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Alex Pancho
Гость
Konst_One,

мне б примерчик, если можно
...
Рейтинг: 0 / 0
14.03.2016, 16:30
| Ответить | Цитировать | Написать  
Вывод в файл в UTF-8
    #39191573
Фотография Konst_One
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Konst_One
Участник
http://developer.rhino3d.com/guides/rhinoscript/read_write_utf8/
...
Рейтинг: 0 / 0
14.03.2016, 16:54
| Ответить | Цитировать | Написать  
Вывод в файл в UTF-8
    #39191781
Alex Pancho
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Alex Pancho
Гость
Konst_One,

Не выходит цветок каменный:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
' Create Error Description
Function funMsgListRecord(sSQL As String)
Dim rst As DAO.Recordset
Dim sListMsg As String
Dim Output As String
Dim strm 'As ADODB.Stream
On Error GoTo Err_
    Set rst = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
    ' New output
    'Debug.Print rst.Value
    
    With rst
        If Not (.BOF And .EOF) Then
            .MoveLast
            .MoveFirst
            Do Until .EOF
                If sListMsg = "" Then
                    Output = "<td>" & !PID & "</td><td>" & !Sname & " " & !fname & "</td><td>" & !fDay & "</td>"
                    sListMsg = Output
                Else
                    Output = "<td>" & !PID & "</td><td>" & !Sname & " " & !fname & "</td><td>" & !fDay & "</td>"
                    sListMsg = sListMsg & "</tr><tr>" & vbCrLf & Output
                End If
                .MoveNext
            Loop
        End If
        .Close
    End With
    Set rst = Nothing
' New output
   
    Set strm = New ADODB.Stream
    strm.Type = adTypeText
    strm.Charset = "utf-8"
    strm.Open
    strm.WriteText sListMsg 'rst.Value '
    ErrLogCreate (strm)
    
    funMsgListRecord = strm
   
' Old output
    'funMsgListRecord = sListMsg
Exit Function

Err_:
    MsgBox Err.Description
    Err.Clear
End Function


' Create errorlog.html if .csv or .txt contain error
Function ErrLogCreate(errmsg As String)
    Dim errorlog As String
    errorlog = CurrentProject.Path & "\errorlog.html"
    Open errorlog For Output As #2
    Print #2, "<!DOCTYPE html><html><head><meta charset=""utf-8"">"
    Print #2, "<title>Error log</title>"
    Print #2, "<style type=""text/css"">"
    Print #2, ".tg  {border-collapse:collapse;border-spacing:0;border-color:#999;}"
    Print #2, ".tg td{font-family:sans-serif;font-size:14px;padding:10px 14px;border-style:solid;border-width:0px;overflow:hidden;word-break:normal;border-color:#999;color:#444;background-color:#F7FDFA;border-top-width:1px;border-bottom-width:1px;}"
    Print #2, ".tg th{font-family:sans-serif;font-size:14px;font-weight:normal;padding:10px 14px;border-style:solid;border-width:0px;overflow:hidden;word-break:normal;border-color:#999;color:#fff;background-color:#26ADE4;border-top-width:1px;border-bottom-width:1px;}"
    Print #2, "</style><body>"
    Print #2, "<h1>Errors in the import file:</h1>"
    Print #2, "<table class=""tg"">"
    Print #2, "<tr><th>Persn ID</th><th>Name</th><th>Date</th></tr>"
    Print #2, "<tr>" & errmsg & "</tr>"
    Print #2, "</table></body></html>"
    Close #2
End Function
...
Рейтинг: 0 / 0
14.03.2016, 21:18
| Ответить | Цитировать | Написать  
Вывод в файл в UTF-8
    #39191819
Alex Pancho
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Alex Pancho
Гость
Alex Pancho,

Все, спасибо вышло, правда пришлось чуток вывод переписать:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
' Create Error Description
Function funMsgListRecord(sSQL As String)
Dim rst As DAO.Recordset
Dim sListMsg As String
Dim Output As String
Dim strm As ADODB.Stream
On Error GoTo Err_
    Set rst = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
    ' New output
    Debug.Print rst(0).Value
    
    With rst
        If Not (.BOF And .EOF) Then
            .MoveLast
            .MoveFirst
            Do Until .EOF
                If sListMsg = "" Then
                    Output = "<td>" & !PID & "</td><td>" & !Sname & " " & !fname & "</td><td>" & !fDay & "</td>"
                    sListMsg = Output
                Else
                    Output = "<td>" & !PID & "</td><td>" & !Sname & " " & !fname & "</td><td>" & !fDay & "</td>"
                    sListMsg = sListMsg & "</tr><tr>" & vbCrLf & Output
                End If
                .MoveNext
            Loop
        End If
        .Close
    End With
    Set rst = Nothing
' New output
   
    Set strm = New ADODB.Stream
    strm.Type = adTypeText
    strm.Charset = "utf-8"
    strm.Open
    strm.WriteText ErrLogCreateNew()
    strm.WriteText sListMsg
    strm.WriteText ("</tr></table></body></html>")
    strm.SaveToFile CurrentProject.Path & "\errorlog.html", 2
Exit Function

Err_:
    MsgBox Err.Description
    Err.Clear
End Function

' Create errorlog.html head and body if .csv or .txt contain error
Function ErrLogCreateNew()
    Dim errorlog As String
    errorlog = "<!DOCTYPE html><html><head><meta charset=""utf-8"">" & _
        "<title>Error log</title>" & _
        "<style type=""text/css"">" & _
        ".tg  {border-collapse:collapse;border-spacing:0;border-color:#999;}" & _
        ".tg td{"ДЛИННОЕ_ОПИСАНИЕ_СТИЛЯ"}" & _
        ".tg th{"ДЛИННОЕ_ОПИСАНИЕ_СТИЛЯ"}" & _
        "</style><body>" & _
        "<h1>Errors in the import file:</h1>" & _
        "<table class=""tg"">" & _
        "<tr><th>Persn ID</th><th>Name</th><th>Date</th></tr>" & _
        "<tr>"
    ErrLogCreateNew = errorlog
End Function
...
Рейтинг: 0 / 0
14.03.2016, 22:45
| Ответить | Цитировать | Написать  
6 сообщений из 6, страница 1 из 1
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Вывод в файл в UTF-8
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=45&msg=39191819&tid=1613822]:
 0ms
get settings:
 10ms
get forum list:
 17ms
check forum access:
 5ms
check topic access:
 5ms
track hit:
 44ms
get topic data:
 12ms
get forum data:
 3ms
get page messages:
 47ms
get tp. blocked users:
 1ms
others: 14ms
total:  158ms
созд. / загр.: 158ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]