Sub AddressMasterChange()
Dim strKenallCsvpath As String
Dim strHeaderFilePath As String
'マスタメンテナンス画面よりCSVファイルパス取得
strKenallCsvpath = "C:\デスクトップ\郵便csv\KEN_ALL.CSV"
'住所マスタの全レコード削除
Call CommandDelete
'ヘッダー用CSVの作成し、ヘッダー用CSVのファイルパスを取得
strHeaderFilePath = CreatetextFile(strKenallCsvpath)
'ヘッダー用CSVにヘッダー文字列を書き込み
Call writeHeader(strHeaderFilePath)
'ヘッダー用CSVにKEN_All.csvの全データを書き込み、M_住所マスタテーブルにインポート
Call readCsv(strKenallCsvpath, strHeaderFilePath)
End Sub
Sub CommandDelete()
'----------------------------------------------
'機能:住所マスタの全レコードを削除
'----------------------------------------------
Dim strSQL As String
strSQL = "DELETE FROM M_住所マスタ"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End Sub
Function CreatetextFile(strTempFilePath As String) As String
'----------------------------------------------
'機能:テキストファイルを作成する
'引数1：読込元CSVのファイルパス
'----------------------------------------------
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strFolderPath As String
Dim strFileName As String
Dim strMaketime As String
Dim strHeadrcsvPath As String
'フルパスからファイル名を取得
strFileName = Dir(strTempFilePath)
'フルパスからフォルダパスを取得
strFolderPath = Replace(strTempFilePath, strFileName, "")
'現在日時を取得
strMaketime = Format(Now(), "yyyyMMddHHmm")
'ファイ作成日時をkenal.csvに追加したパスでヘッダー用CSVを作成
strHeadrcsvPath = strFolderPath & strMaketime & strFileName
objFSO.CreatetextFile (strHeadrcsvPath)
Set objFSO = Nothing
'呼び出し元にヘッダー用CSVのパスを返す
CreatetextFile = strHeadrcsvPath
End Function
Sub writeHeader(strFilePath As String)
'-------------------------------------------------------
'機能:ヘッダー用ファイルにヘッダー項目を書き込んで保存
'引数1：ヘッダー書き出し先CSVのファイルパス
'-------------------------------------------------------
Dim strHeader As String
Dim intFileNumber As Integer
Dim buf As String
intFileNumber = FreeFile
strHeader = """全国地方公共団体コード""" & "," & _
"""（旧）郵便番号（5桁）""" & "," & _
"""郵便番号（7桁）""" & "," & _
"""都道府県名カナ""" & "," & _
"""市区町村名カナ""" & "," & _
"""町域名カナ""" & "," & _
"""都道府県名""" & "," & _
"""市区町村名""" & "," & _
"""町域名""" & "," & _
"""一町域が二以上の郵便番号で表される場合の表示""" & "," & _
"""小字毎に番地が起番されている町域の表示""" & "," & _
"""丁目を有する町域の場合の表示""" & "," & _
"""一つの郵便番号で二以上の町域を表す場合の表示""" & "," & _
"""更新の表示""" & "," & _
"""変更理由"""
Open strFilePath For Output As #intFileNumber
Print #intFileNumber, strHeader
Close #intFileNumber
End Sub
Sub readCsv(strKenallCsvpath, strHeaderFilePath)
'--------------------------------------------------------------------
'CSVファイルを読み込みデータをヘッダーファイルに書き込み
'引数1：データコピー元のCSVファイルパス
'引数2:データコピー先のCSVファイルパス
'--------------------------------------------------------------------
Dim intFileNumber As Integer
Dim buf As String
Dim all As String
Dim strSQL As String
'ファイル番号取得
intFileNumber = FreeFile
'読込CSVファイルをバイナリモードで開く
Open strKenallCsvpath For Binary As #intFileNumber
'ファイルの長さを取得して変数bufの大きさを確保する
buf = Space(FileLen(strKenallCsvpath))
'変数bufにCSVデータ全件を読込
Get #intFileNumber, , buf
'読込CSVを閉じる
Close #intFileNumber
'書込用CSVのファイル番号取得
intFileNumber = FreeFile
'書込用CSVを追記モードで開く
Open strHeaderFilePath For Append As #intFileNumber
'読込用CSVの全データ書込
Print #intFileNumber, buf
'書込用CSVを閉じる
Close #intFileNumber
'CSVファイルを住所マスタにインポート
DoCmd.TransferText acImportDelim, , "M_住所マスタ", strHeaderFilePath, True
'インポート時に先頭に空のレコードが入ってしまうので消す
strSQL = "DELETE FROM M_住所マスタ WHERE 全国地方公共団体コード IS NULL"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'ヘッダーCSV削除
Kill strHeaderFilePath
End Sub
