accessのVABを使ったインポートについて
accessへのインポートについて質問です。
VBAをつかってボタンを押すとファイル選択ダイアログが開き選択すると既存のテーブルへインポートするものを作成したいと考えています。
検索して出てきたものを加工して使ってみているのですが理想形になりません。
現状いまのままでも使えてはいるのですがより効率的にしたいと思っています。
具体的には以下の２点を修正したいと考えています。
・元データは本来はＣＳＶのためＣＳＶのまま取り込みたい
範囲指定の際にExcelの関数を使って求めているためそれをCSV
現状はCSVを一度Excelに修正しています。
・Ａ２のセルに日付（ユーザー定義ｙｙｙｙ年ｍｍ月ｄｄ日）が入っているためそれをUPDATEだデータに追加したい
現状は入力を求められるためそこに入力すると反映されます。
また、反映時はｙｙｙｙ/ｍｍ/ｄｄという表記で表示をしたいです。
一応Gとしてデータの取得はしていると思うのですがうまくいきません。
取り込むデータをCSVとExcelにしているのはもう一つ取込用のボタンがありそちらの取込はCSVだからです。
（CSVだけで取り込めるようになったらExcelは消します）
独学でネットにあるものをつまんでいる状況のため専門用語などが分からず説明が足りていないところなどありましたらご質問下さい。
宜しくお願い致します。
Private Sub コマンド1_Click()
Dim msg As String
msg = getFilePicker
If msg = "" Then Exit Sub
Dim objFileSys As Object
Dim fileName As String
Dim FN As Variant
'ファイルシステムを扱うオブジェクトを作成
Set objFileSys = CreateObject("Scripting.FileSystemObject")
'拡張子無しのファイル名を取得
fileName = objFileSys.GetBaseName(msg)
FN = objFileSys.GetAbsolutePathName(msg)
Dim b As Long
Dim r As Long
Dim G As Date
With CreateObject("Excel.Application")
With .Workbooks.Open(FN)
'G = CDate(.Sheets(fileName).Range("A2").Value)
b = .Sheets(fileName).Cells(1, 1).End(-4121).row
.Close False
End With
End With
DoCmd.TransferSpreadsheet acImport, , "T_G", msg, True, "B7:I" & b
Dim sql As String
DoCmd.SetWarnings WarningsOn:=False
sql = "UPDATE T_G SET 入金日 = G WHERE Nz(入金日)=''"
DoCmd.RunSQL sql
DoCmd.SetWarnings WarningsOn:=True
Set objFileSys = Nothing
On Error GoTo err_sample
err_sample:
Select Case Err.Number
Case 3011
MsgBox "ファイルが見つかりません。処理を終了します。"
Case Else
MsgBox Err.Number & ":" & Err.Description
End Select
End Sub
Function getFilePicker(Optional dTitle As String = "ファイル選択")
Const msoFileDialogFilePicker As Integer = 3
Dim fDlg As Object
Set fDlg = Application.FileDialog(msoFileDialogFilePicker)
fDlg.Title = dTitle
fDlg.InitialFileName = "ダウンロード" '任意のフォルダパスを入れてください
fDlg.AllowMultiSelect = False
fDlg.Filters.Clear
fDlg.Filters.Add "Excel Files(*.xls)", "*.xlsx;*.xls"
fDlg.Filters.Add "Text Files(*.csv;*.txt)", "*.csv;*.txt"
fDlg.FilterIndex = 1
If fDlg.Show Then getFilePicker = fDlg.SelectedItems(1) Else getFilePicker = ""
End Function
お礼
お早うございます。 その後あらためて Public Function myRND(anyField) Randomize myRND = 100*Rnd '……(No.)を削除 End Function を試しましたところ、期待通り都度数列が変化しました。 myRNDについては9/26にもお教えいただいてます。 何度もお手数かけすみませんでした。
補足
ご回答ありがとうございます。 標準モジュールで Public Function myRND(anyField) Randomize myRND = 100*Rnd End Function として DoCmd.RunSQL "update 回答 set 整列No.=myRND(now()) " としましたが結果は同じです。 myRND()の （）内にテキストボックス、数値 等試しましたが変化はありません ご面倒でしょうが再度ご指導お願いいたします。