リストボックス 複数選択の場合の値取得
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
補足
(2)すいません。モジュールは伐採しております。 (3)ご指摘ありがとうございます。初心者なのでネットから集めたのを 色々混ぜて作ったのですが、やはり普通とは違いますよね・・・ ご指摘ありがとうございます。 ちなみに(1)ですが3.5を設定していればこのコードは出来ますでしょうか? すいません。変なご質問で