テキスト取込からのデータ取込編集エラーについて
ACCESS97でインポートしたテキストを文字を変換させて新しく修正したテキストを
作成したい流れですがエラーになります。
ご教授お願いします。
ユーザー定期型は定義されていません。
↓チェックとを入れると
Microsoft DAO 3.6 Object Library
↓下記のエラーになります
この名前は既にあるモジュール、プロジェクト、オブジェクトライブラリで使われています。
Private Sub cmd選択_Click()
Dim objExcel As Object
Dim varFilePath As Variant
Dim bln As Boolean
Dim infname As String
Dim TName As String
TName = "取込用"
Call F_ExecuteSQL("DELETE FROM " & TName & "")
Set objExcel = CreateObject("Excel.Application")
varFilePath = objExcel.GetOpenFileName("Microsfot Access (*.txt), *.txt", , "txt選択")
If varFilePath <> False Then
infname = varFilePath
DoCmd.TransferText acImportDelim, "取込定義", TName, infname, True
Call Div
MsgBox "修正したデータを正常出力しました。"
End If
Set objExcel = Nothing
End Sub
Private Sub Div()
Dim infname As String
Dim outfname As String
Dim n_in As Integer
Dim n_out As Integer
Dim tmpREC As typREC
Dim tmpSP As typSpace
Dim tmpNL As typNewLine
Dim tmpStr As String
outfname = myReplaceB(infname, ".txt", ".r.txt")
n_out = FreeFile()
Open outfname For Output As #n_out
n_in = FreeFile()
Open infname For Binary As #n_in
Get #n_in, , tmpNL
Do Until EOF(n_in)
Get #n_in, , tmpREC
tmpStr = myReplaceB(tmpREC.REC400, Chr(0), "")
Print #n_out, tmpStr
'datファイルが改行されてる場合は改行コードを読み捨て
Get #n_in, , tmpSP
Get #n_in, , tmpSP
Get #n_in, , tmpSP
Get #n_in, , tmpSP
Loop
Close #n_in
Close #n_out
End Sub
Function myReplaceB(ByVal myString, ByVal myFind, ByVal myRp)
'Access2000風 replace関数 (Access97、Excel97用)
'「大文字小文字半角全角カタカナひらがな」を区別する 2003/10/11 pPoy
Dim strTmp As String
Dim wk1 As Integer, wk2 As Integer
Dim wk3 As Integer, wk4 As Integer
'準備
If IsNull(myString) Then Exit Function
If IsNull(myFind) Then Exit Function
wk4 = Len(myFind) '検索する文字数
wk3 = Len(myString) '検索対象の文字数
'最初に見つかった位置
wk2 = InStr(1, myString, myFind, vbBinaryCompare)
wk1 = 1 '検索開始位置
'無ければそのまま
If wk2 = 0 Then
myReplaceB = myString
Exit Function
End If
'文字の最後まで置換
Do
strTmp = strTmp & Mid(myString, wk1, wk2 - wk1) & myRp
wk1 = wk2 + wk4
wk2 = InStr(wk1, myString, myFind, vbBinaryCompare)
Loop Until wk2 = 0
strTmp = strTmp & Mid(myString, wk1, wk3)
myReplaceB = strTmp
End Function