chesterluck
New member
- Local time
- Today, 15:39
- Joined
- May 2, 2011
- Messages
- 1
Hi,
I have a problem to convert automatically files to csv format with utf8 coding.
I first tried to work with DoCmd.TransferText SpecifiedName, and everything seemed to be fine. But as i work with different Files, I can't use this option anymore.
So i tried to use the more flexible possibility with schema.ini.
Here the scheme.ini:
The code is creating a scheme.ini, but the generated file doesn't seem to use the .ini.
And when i actually let the code with CharacterSet = UTF-8 , i get the error 3000 (is not described at all).
Please help , I really pissed off and dont know how to proceed
Thx in advance
//chesterluck
I have a problem to convert automatically files to csv format with utf8 coding.
I first tried to work with DoCmd.TransferText SpecifiedName, and everything seemed to be fine. But as i work with different Files, I can't use this option anymore.
So i tried to use the more flexible possibility with schema.ini.
Code:
Public Sub importing_exporting_file()
Dim strPathFile As String
Dim strTable As String, strBrowseMsg As String
Dim strFilter As String, strInitialDirectory As String
Dim blnHasFieldNames As Boolean
Dim Share As String
Dim Path_full As String
Dim path As String
Dim Last_week As Integer
'Calculating last week
t = DateSerial(Year(Date + (8 - Weekday(Date)) Mod 7 - 3), 1, 1)
KW = (Date - t - 3 + (Weekday(t) + 1) Mod 7) \ 7 + 1
Last_week = KW - 1
'Selecting the share for the Excel Files
Share = InputBox("Please type in the letter of your share (i.e.: C)", , "Z")
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False
strBrowseMsg = "Select the EXCEL file:"
' Change C:\MyFolder\ to the path for the folder where the Browse
' window is to start (the initial directory). If you want to start in
' ACCESS' default folder, delete C:\MyFolder\ from the code line,
' leaving an empty string as the value being set as the initial
' directory
'strInitialDirectory = "C:\"
path = "import\"
Path_full = Share & ":\" & path & "week_" & Last_week & "\xls"
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
strPathFile = ahtCommonFileOpenSave(InitialDir:=Path_full, _
Filter:=strFilter, OpenFile:=True, _
DialogTitle:=strBrowseMsg, _
Flags:=ahtOFN_HIDEREADONLY)
If strPathFile = "" Then
MsgBox "No file was selected.", vbOK, "No Selection"
Exit Sub
End If
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "Import"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames '
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
'******************************EXPORT*************************************
'*****************FILE_NAME******************************
Dim Pos As Integer, SuchZeichen As String
If strPathFile = "" Then Exit Sub
' Letzten Backslash suchen
Pos = 0
Do
strPathFile = Mid(strPathFile, Pos + 1)
Pos = InStr(1, strPathFile, "\")
Loop Until Pos = 0
If IsMissing(MitEndung) Then MitEndung = True
If Not MitEndung Then
' Letzten Punkt suchen
For Pos = Len(strPathFile) To 1 Step -1
If Mid(strPathFile, Pos, 1) = "." Then
strPathFile = Left(strPathFile, Pos - 1)
Exit For
End If
Next Pos
End If
DateiName = strPathFile
'MsgBox (DateiName)
'******************************************Create schema.ini****************************************************************
Dim bIncFldNames As Boolean
bIncFldNames = False
Dim sPath As String
sPath = Share & ":\" & path & "week_" & Last_week & "\csv\"
Dim sSectionName As String
sSectionName = DateiName & ".csv"
Dim sTblQryName As String
sTblQryName = "Import"
Call CreateSchemaFile(bIncFldNames, sPath, sSectionName, sTblQryName)
'**************************EXPORT_PROCEDURE*****************
Dim Target_Path As String
Target_Path = Share & ":\" & path & "week_" & Last_week & "\csv\" & DateiName & ".csv"
MsgBox (Target_Path)
DoCmd.TransferText acExportDelim, , "Import", Target_Path, 0
'******************************Delete_Table*************************************
DoCmd.DeleteObject acTable, "Import"
End Sub
Code:
Public Function CreateSchemaFile(bIncFldNames As Boolean, _
sPath As String, _
sSectionName As String, _
sTblQryName As String) As Boolean
Dim Msg As String ' For error handling.
On Local Error GoTo CreateSchemaFile_Err
Dim ws As Workspace, db As DAO.Database
Dim tblDef As DAO.TableDef, fldDef As DAO.Field
Dim i As Integer, Handle As Integer
Dim fldName As String, fldDataInfo As String
' -----------------------------------------------
' Set DAO objects.
' -----------------------------------------------
Set db = CurrentDb()
' -----------------------------------------------
' Open schema file for append.
' -----------------------------------------------
Handle = FreeFile
Open sPath & "schema.ini" For Output Access Write As #Handle
' -----------------------------------------------
' Write schema header.
' -----------------------------------------------
Print #Handle, "[" & sSectionName & "]"
Print #Handle, "ColNameHeader = " & _
IIf(bIncFldNames, "True", "False")
Print #Handle, "CharacterSet = UTF-8"
Print #Handle, "Format = Delimited(*)"
'Print #Handle, "TextDelimiter = ¦ "
' -----------------------------------------------
' Get data concerning schema file.
' -----------------------------------------------
Set tblDef = db.TableDefs(sTblQryName)
With tblDef
For i = 0 To .Fields.Count - 1
Set fldDef = .Fields(i)
With fldDef
fldName = .Name
Select Case .Type
Case dbBoolean
fldDataInfo = "Bit"
Case dbByte
fldDataInfo = "Byte"
Case dbInteger
fldDataInfo = "Short"
Case dbLong
fldDataInfo = "Integer"
Case dbCurrency
fldDataInfo = "Currency"
Case dbSingle
fldDataInfo = "Single"
Case dbDouble
fldDataInfo = "Double"
Case dbDate
fldDataInfo = "Date"
Case dbText
fldDataInfo = "Char Width " & Format$(.Size)
Case dbLongBinary
fldDataInfo = "OLE"
Case dbMemo
fldDataInfo = "LongChar"
Case dbGUID
fldDataInfo = "Char Width 16"
End Select
Print #Handle, "Col" & Format$(i + 1) _
& "=" & fldName & Space$(1) _
& fldDataInfo
End With
Next i
End With
MsgBox sPath & "SCHEMA.INI has been created."
CreateSchemaFile = True
CreateSchemaFile_End:
Close Handle
Exit Function
CreateSchemaFile_Err:
Msg = "Error #: " & Format$(Err.Number) & vbCrLf
Msg = Msg & Err.Description
MsgBox Msg
Resume CreateSchemaFile_End
End Function
And when i actually let the code with CharacterSet = UTF-8 , i get the error 3000 (is not described at all).
Please help , I really pissed off and dont know how to proceed
Thx in advance
//chesterluck