ACCESS2003を使用しています。
今、下記のプログラムにて
リストボックスからファイル名を選び
CSVをインポートさせ、更に選択したファイル名を新しいフィールドに書き込みをする。というシステムを作っています。
現在のプログラムですと、一つを選択した場合はうまく書き込めます。
ですが、複数同時選択する事はできますでしょうか?
長くて見づらいプログラムですが、参考までに掲載します。
よろしくお願いします。
Private Sub Form_Load()
Dim oFSO As Object
Dim oFile As Object
Dim sTmp As String
Const FolderPath = "\\St1\第2業務部\$運用\TESTkanno"
sTmp = ""
Set oFSO = CreateObject("Scripting.FileSystemObject")
For Each oFile In oFSO.GetFolder(FolderPath).files
If (Right(oFile.Name, 3) = "csv") Then
sTmp = sTmp & ";" & Left(oFile.Name, InStr(oFile.Name, ".") - 1)
End If
Next
If (Len(sTmp) > 0) Then
sTmp = Mid(sTmp, 2)
End If
Me.lst_01.RowSource = sTmp
'Me.lst_01 = Null
Set oFSO = Nothing
End Sub
Private Sub Cmd_01_Click()
Dim ercd As Integer
Dim LsName As String
Dim TName As String
Dim ITName As String
Dim Name1 As String
Dim Name2 As String
Dim teigi As String
Dim SQL As String
Dim aa As Long
Dim mySQL As String
Dim db As Database
Dim i As Integer
Dim varData As Variant
Dim strSelected As String
strSelected = vbNullString
With lst_01
For Each varData In .ItemsSelected
strSelected = strSelected & .ItemData(varData - 1) & " "
Next
End With
'ファイル名の取得
strError = 0
LsName = "\\St1\第2業務部\$運用\TESTkanno\"
TName = Left(strSelected, Len(strSelected) - 1)
LsName = LsName & TName & ".csv"
ITName = "T_Mas"
'レコードの追加
teigi = "RGB定義"
DoCmd.TransferText acImportDelim, teigi, ITName, LsName, True
SQL = "INSERT INTO T_Mas (ID1,ID,処理状況,請求日,学校識別コード,学校名,学校分類名,メールアドレス,名前,ふりがな,性別,生年月日,職業,高校所在地,高校名,学年,郵便番号,都道府県,区市町村&町域,番地以下,電話番号,FileName,区分,不備,不備理由,yu,gid,保留,処理済,件数報告日,納品日 )" & _
" SELECT [" & TName & "].[ID1], [" & TName & "].[ID],[" & TName & "].[処理状況], [" & TName & "].[請求日]," & _
" [" & TName & "].[学校識別コード], [" & TName & "].[学校名], [" & TName & "].[学校分類名], [" & TName & "].[メールアドレス]," & _
" [" & TName & "].[名前], [" & TName & "].[ふりがな], [" & TName & "].[性別], [" & TName & "].[生年月日]," & _
" [" & TName & "].[職業], [" & TName & "].[高校所在地], [" & TName & "].[高校名], [" & TName & "].[学年]," & _
" [" & TName & "].[郵便番号], [" & TName & "].[都道府県], [" & TName & "].[区市町村&町域], [" & TName & "].[番地以下]," & _
" [" & TName & "].[電話番号], [" & TName & "].[FileName], [" & TName & "].[区分], [" & TName & "].[不備], [" & TName & "].[不備理由], [" & TName & "].[yu], [" & TName & "].[gid]," & _
" [" & TName & "].[保留], [" & TName & "].[処理済], [" & TName & "].[件数報告日],[" & TName & "].[納品日], From" & "LsName"
Name1 = TName & ".csv"
Name2 = Left(TName, Len(TName) - 5)
ret = MsgBox(Name1 & "を FileName、" & Name2 & "を 区分に追加しますか?", vbYesNo + vbQuestion, "インポート確認")
Dim sql1 As String
sql1 = "Update T_Mas SET FileName = '" & Name1 & "',区分 = '" & Name2 & "'" & " WHERE FileName Is Null AND 区分 Is Null"
DoCmd.RunSQL sql1
End Sub
A 回答 (2件)
- 最新から表示
- 回答順に表示
No.1
- 回答日時:
ちょっと見しかできてませんが、
複数選択のものを , カンマ区切りで作っておいて、処理前で配列に。
その配列を使って、テーブル名、ファイルバスを作ればよいのでは。
> Dim strSelected As String
> strSelected = vbNullString
> With lst_01
> For Each varData In .ItemsSelected
> strSelected = strSelected & .ItemData(varData - 1) & " "
> Next
> End With
↓
Dim strSelected As String
Dim vTmp As Variant
Dim SubLsName As String
strSelected = ""
With lst_01
For Each varData In .ItemsSelected
strSelected = strSelected & "," & .ItemData(varData - 1) ' ★
Next
End With
vTmp = Split(Mid(strSelected,2),",")
LsName = "\\St1\第2業務部\$運用\TESTkanno\"
ITName = "T_Mas"
For i = 0 To UBound(vTmp)
TName = vTmp(i)
SubLsName = LsName & TName & ".csv"
DoCmd.TransferText acImportDelim, teigi, ITName, SubLsName, True
・・・・・・・
Next
※ ★前の処理が正しいとして流用
※ 従来の LsName 扱いは、使い回しができないように上書きされています。
LsName = LsName & TName & ".csv"
※ 後は細かく見れてません。がんばってください。
No.2
- 回答日時:
時間があったので、雰囲気作ってみました。
なるべく元の変数名を使うようにしていますが、細かい判別部分は分かってません。
(SQLの文字列がどこで使われているのかもわからなかったので)
雰囲気で見てください。雰囲気で。(検証とかしてません)
一時テーブルへ取り込みUpdate操作後、本テーブルへ追加する方法として
一時テーブルは本テーブルと同じ構造で既に存在していると想定
(DoCmd.TransferText の時にテーブルが新規に作られる?)
ファイル名にドット(ピリオド)が複数あった場合用に InStrRev に変更
Const FolderPath = "\\St1\第2業務部\$運用\TESTkanno"
Const ITName = "T_Mas"
Const TmpITName = "Tmp_Mas" ' ★ T_Mas 構造と同じ取り込み用一時テーブル名
Const teigi = "RGB定義"
Private Sub Form_Load()
Dim oFSO As Object
Dim oFile As Object
Dim sName As String
Dim sTmp As String
sTmp = ""
Set oFSO = CreateObject("Scripting.FileSystemObject")
For Each oFile In oFSO.GetFolder(FolderPath).files
sName = oFile.Name
If (Right(sName, Len(sName) - InStrRev(sName, ".")) = "csv") Then
sTmp = sTmp & ";" & Left(sName, InStrRev(sName, ".") - 1)
End If
Next
If (Len(sTmp) > 0) Then
sTmp = Mid(sTmp, 2)
End If
Me.lst_01.RowSource = sTmp
Set oFSO = Nothing
End Sub
Private Sub Cmd_01_Click()
Dim LsName As String
Dim TName As String
Dim Name1 As String
Dim Name2 As String
Dim ret As Variant
Dim sSql As String
Dim iTmp As Long
For Each iTmp In Me.lst_01.ItemsSelected
TName = Me.lst_01.ItemData(iTmp)
LsName = FolderPath & "\" & TName & ".csv"
' 一時テーブルへまずは取り込み
CurrentProject.Connection.Execute "DELETE * FROM " & TmpITName
DoCmd.TransferText acImportDelim, teigi, TmpITName, LsName, True
Name1 = TName & ".csv"
Name2 = Left(TName, Len(TName) - 5)
ret = MsgBox(Name1 & "を FileName、" & Name2 & "を 区分に追加しますか?", _
vbYesNo + vbQuestion, "インポート確認")
If (ret = vbYes) Then
sSql = "UPDATE " & TmpITName & " SET FileName = '" & Name1 & "',区分 = '" & Name2 & "'"
CurrentProject.Connection.Execute sSql
' 一時テーブルから正式なテーブルへ (必要なら除外フィールド指定)
sSql = InsertSqlMakeFromTable(ITName, TmpITName)
Debug.Print sSql
If (Len(sSql) > 0) Then
CurrentProject.Connection.Execute sSql
End If
End If
Next
End Sub
---以下を標準モジュールへ作成---
' 追加クエリ作成用ファンクション (条件設定なし)
' sTo : 追加先テーブル名
' sFrom : 追加元テーブル名
' sBase : フィールド名参照テーブル名(省略時 sTo 使用)
' sExclusion : 追加除外フィールド名(オートナンバーなど除外するためのもの)
' 複数指定時は、,カンマ区切り
'
' 戻り値: INSERT INTO で始まるSQL文
'
' ※ ADOX使用のため、参照設定に ADO Ext が必要
'
Public Function InsertSqlMakeFromTable(sTo As String, sFrom As String, _
Optional sBase As String = "", _
Optional sExclusion As String = "") As String
Dim catdb As New ADOX.Catalog
Dim clm As Column
Dim sTable As String
Dim sToTmp As String
Dim sFromTmp As String
Dim vTmp As Variant
Dim i As Integer
Dim bFound As Boolean
On Error GoTo ERR_HAND
sTable = IIf(Len(sBase) = 0, sTo, sBase)
If (Len(sExclusion) > 0) Then
vTmp = Split(sExclusion, ",")
End If
sToTmp = ""
sFromTmp = ""
catdb.ActiveConnection = CurrentProject.Connection
For Each clm In catdb.Tables(sTable).Columns
bFound = False
If (Not IsEmpty(vTmp)) Then
For i = 0 To UBound(vTmp)
If (clm.Name = vTmp(i)) Then
bFound = True
Exit For
End If
Next
End If
If (bFound = False) Then
sToTmp = sToTmp & ", [" & clm.Name & "]"
sFromTmp = sFromTmp & ", [" & sFrom & "].[" & clm.Name & "]"
End If
Next
If (Len(sToTmp) > 0) Then
InsertSqlMakeFromTable = "INSERT INTO " & sTo & " (" & Mid(sToTmp, 3) & ") " & _
"SELECT " & Mid(sFromTmp, 3) & " FROM " & sFrom & ";"
Else
InsertSqlMakeFromTable = ""
End If
Exit Function
ERR_HAND:
InsertSqlMakeFromTable = ""
End Function
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 1 2023/08/08 15:45
- Visual Basic(VBA) VBA 請求書自動作成 3 2022/04/24 01:58
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 複数のcsvファイルをExcelに一括変換したい 2 2023/03/03 12:44
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
- Visual Basic(VBA) EXCEL VBAにて動的にCheckBOXを複数作成し、同BOXにイベントを追加したい 1 2023/03/16 07:05
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Access(アクセス) DoCmd.SearchForRecord が動かない時の解決方法 3 2022/07/22 15:31
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Accessでテーブル名やクエリ名...
-
Accessクエリでの、LIKE条件
-
2つのテーブルを比較して一致し...
-
Accessでテーブルからテーブル...
-
ACCESSで指定されたテーブルか...
-
Accessの追加クエリで既存のテ...
-
ACCESSに同時アクセス(編集)を...
-
リンクテーブルを CopyObject ...
-
Accessレコードの追加や変更が...
-
AccessをMDBファイルで使う場合...
-
SQLで日付を条件に削除したい
-
ODBCで接続するとDBに変更/追加...
-
ツリー構造をRDBで表現するには?
-
データ型の変更
-
Accessのフォームの並び替えを...
-
データベースで変更の多いテー...
-
DAOのTableDefs("TblName").Con...
-
3つの表を1つに縦に連結する
-
Access SELECT INTO に関する質...
-
AccessのDlookupの引数設定につ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Accessでテーブル名やクエリ名...
-
ACCESSに同時アクセス(編集)を...
-
Accessでvlookupみたいなことは...
-
Accessでテーブルからテーブル...
-
Accessクエリでの、LIKE条件
-
Accessレコードの追加や変更が...
-
access テーブル内のレコード...
-
3つの表を1つに縦に連結する
-
SQLで日付を条件に削除したい
-
Accessの追加クエリで既存のテ...
-
SQLで条件指定結合をしたいがNU...
-
デザインビューで、連結式 を...
-
ツリー構造をRDBで表現するには?
-
ACCESSで指定されたテーブルか...
-
リンクテーブルを CopyObject ...
-
2つのテーブルを比較して一致し...
-
時間の足し算
-
ODBCで接続するとDBに変更/追加...
-
パススルークエリをテーブル作...
-
INSERT時にデータ登録とmaxの発...
おすすめ情報