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

このQ&Aに関連する最新のQ&A

A 回答 (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
    • good
    • 0

ちょっと見しかできてませんが、



複数選択のものを , カンマ区切りで作っておいて、処理前で配列に。
その配列を使って、テーブル名、ファイルバスを作ればよいのでは。


> 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"

※ 後は細かく見れてません。がんばってください。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング