Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Вывод в файл в UTF-8 / 6 сообщений из 6, страница 1 из 1
14.03.2016, 15:15
    #39191465
Alex Pancho
Alex Pancho
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вывод в файл в UTF-8
В базе используется текст в кодировке 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:38
    #39191493
Konst_One
Konst_One
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вывод в файл в UTF-8
используйте ADODB.Stream с указанием кодовой страницы в output
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
14.03.2016, 16:30
    #39191548
Alex Pancho
Alex Pancho
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вывод в файл в UTF-8
Konst_One,

мне б примерчик, если можно
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
14.03.2016, 16:54
    #39191573
Konst_One
Konst_One
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вывод в файл в UTF-8
http://developer.rhino3d.com/guides/rhinoscript/read_write_utf8/
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
14.03.2016, 21:18
    #39191781
Alex Pancho
Alex Pancho
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вывод в файл в UTF-8
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, 22:45
    #39191819
Alex Pancho
Alex Pancho
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Вывод в файл в UTF-8
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
| Ответить | Цитировать | Написать  
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Вывод в файл в UTF-8 / 6 сообщений из 6, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
созд. / загр.: 124ms
Закрыть
start [/forum/topic.php?fid=45&mobile=1&tid=1613822]:
 0ms
get settings:
 9ms
get forum list:
 12ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 32ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 42ms
get tp. blocked users:
 1ms
others: 9ms
total:  124ms
x
x
Закрыть


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