ディレクトリ内にある複数のエクセルブックをVBAで抽出しsql serverに格納し登録したい。

現在現在VBAでディレクトリ内にある複数のエクセルブック（内容は履歴書のようなもの）をVBAで抽出しSQLServerに格納するプログラミングを作成しています。
しかし今回VBAを初めて触るということと、あまりプログラミング経験がないことも手伝って、DBに接続程度のプログラムしか作れていない状況です。(データの抽出？どうやって？という状況)
そこで前回質問をし下記のサンプルを頂きある程度の解決ができましたが、追加機能でディレクトリ内のエクセルブックからデータを抽出をしなければいけなくなりました。
なにとぞ知恵をお貸しください。

追記
データに関しては一名一ファイルで形式は基本的な履歴書、内容は基本情報、資格、履歴という感じ。

サンプル

Sub Mysql_連続insert()

'ExcelでADO・ADODBへの参照設定で下記をチェック（古いバージョンでも可）
'Microsoft ActiveX 'Data Objects 6.1 Library

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Dim connectionString As String
Dim sqlStr As String

Dim id As String
Dim name As String
Dim password As String
Dim section As String

'接続文字列
connectionString = "Driver={MySQL ODBC 8.0 ANSI Driver};" _
& " SERVER=localhost;" _
& " DATABASE=db_users;" _
& " USER=root;" _
& " PASSWORD=test;"

'ADODB.Connection生成
Set cn = New ADODB.Connection

On Error GoTo Err

'MySQLに接続
cn.Open connectionString

For i = 2 To 6000

With Sheets("data1")
    id = .Range("A" & i).Value
    name = .Range("B" & i).Value
    password = .Range("C" & i).Value
    section = .Range("D" & i).Value

End With

    sqlStr = "insert into t_users (id,name,password,section) values ('" & id & "','" & name & "','" & password & "','" & section & "')"
    Set rs = cn.Execute(sqlStr)

cn.Close
Set rs = Nothing
Set cn = Nothing

MsgBox "データの登録がおわりました"
Exit Sub

Err:
Set rs = Nothing
Set cn = Nothing
MsgBox (Err.Description)

End Sub

mdj

2020/07/27 02:41

「vba ディレクトリファイル開く」でぐぐるとそれっぽいことが書かれているQiitaがヒットすると思います。まずはそれを参考に、出来るところまでやってみてはいかがでしょうか。

tokumeikibou162

2020/07/27 03:20

確かに、一度そちらの方で調べてみます。

行動規範の内容に同意します

回答2件

ベストアンサー

データ収集（例）です。よく使うマクロですのでアレンジしていただければと思います。
一つのシートに個々の履歴書のデータを収集するというサンプルです。

今回は、sqlserverへのデータインサートの部分にはふれませんのでのでお願いします。
（ODBC接続の部分がmysqlのままですので修正してくださいね）

では、データ収集用のエクセル（VBA）ファイルを作成します。
エクセルファイル名：main.xlsm　シート名：alldataとします。
データ収集内容はサンプルですので、ファイル名、氏名、最終学歴、志望理由のみとします。
データ取り込みのイメージは下記となりますが、タイトル行A1〜D1に入力しておいてください。
この下に個々のデータを取り込んで転記します。

次に、標準モジュールに下記マクロ（データ収集マクロ）をコピーします。
転記したら、いったん保存して収集用エクセルを閉じます。

ファイル名	氏名	最終学歴	志望理由
履歴書1.xlsx	Y太郎	XXX	XXX
履歴書2.xlsx	Y太郎	XXX	XXX
履歴書3.xlsx	Y太郎	XXX	XXX
履歴書4.xlsx	Y太郎	XXX	XXX
履歴書5.xlsx	Y太郎	XXX	XXX
履歴書6.xlsx	Y太郎	XXX	XXX

次に、履歴書のエクセルファイル（ファイル名の例として履歴書1.xlsxとしています）を準備します。
ファイル名は個人名でもなんでもかまいません（拡張子はxlsxです）。
また、履歴書をいうシートを準備し、シートには氏名、学歴、志望理由を入力しておいてください。
（わかりずらいと思いますが、A列にタイトル行、B列をデータとしています）
準備ができたら、個人ファイルと閉じた状態で、データ収集用エクセルのマクロを実行します。
この際、データ収集用エクセルファイルと、各個々のエクセルファイルを同一フォルダに入れてください。
個人用ファイルを、データ収集用ファイルと別ファイルとしたい場合は
FolderPath = ThisWorkbook.Path & ""の部分をフルパスに修正をお願いします。

A列　　　　　B列

1 氏名　　　デモ太郎
2 学歴　　　XX大学
3 志望理由　なんとなく

これをデータ収集するサンプルを提示します。
今回は、sqlserverは無視します（データ収集後に、提示されているサンプルを実行するとよろしいかと思います）。

VBA
1Sub データ収集()
2    Dim FolderPath As String
3    Dim filename As String
4    Dim excellist As String
5    Dim ws As Workbook
6    Dim cnt As Long
7
8    'main.xlsmと各履歴書を同一フォルダ内に配置すること
9
10Application.ScreenUpdating = False
11
12    FolderPath = ThisWorkbook.Path & "\" 'パス指定の場合は・・"C:\Sample\"
13    
14    cnt = 1
15    
16    filename = Dir(FolderPath & "*.xlsx")
17    
18    Do While filename <> ""
19        cnt = cnt + 1
20        
21        excellist = FolderPath & filename
22        
23        ThisWorkbook.Sheets("alldata").Range("A" & cnt) = filename
24        
25        Set wb = Workbooks.Open(excellist) '■bookを開く
26            
27        With ThisWorkbook.Sheets("alldata")
28            .Range("B" & cnt).Value = wb.Sheets("履歴書").Range("B1").Value'氏名
29            .Range("C" & cnt).Value = wb.Sheets("履歴書").Range("B2").Value'最終学歴
30            .Range("D" & cnt).Value = wb.Sheets("履歴書").Range("B3").Value'志望理由
31        End With
32        
33         wb.Close savechanges:=False
34        
35        
36        filename = Dir()
37    Loop
38
39    Set wb = Nothing
40    Application.ScreenUpdating = True
41　　msgbox "データを収集しました！"
42End Sub

マクロを実行するとmain.xlsmのalldataシートに作成した分のエクセルファイルの履歴書データを
一つのファイルにまとめられるはずです。

以上　よろしくお願いいたします。

投稿2020/07/27 19:22

編集2020/07/27 21:37

mako1972

総合スコア383

tokumeikibou162

2020/07/28 02:14

前回に引き続きありがとうございます。質問なのですが、マクロ自体は、取集ファイル以外のファイルに格納するという形でしょうか？（二重開きエラーが出てしまうため）

mako1972

2020/07/28 02:25 編集

マクロはmain.xlsmの標準モジュールにのみ記載します。各履歴書はただのエクセルファイルです。 ★マクロ実行時には、各個人ファイルが閉じている状態で実行をお願いいたします。実行するマクロはmain.xlsm、同じフォルダ内に配置して結構です（自動でOPENして閉じます）。 main.xlsmを起動しalldataシートが選択された状態でデータ収集マクロを実行すると、同一フォルダ内のエクセルファイルを一つ一つ開いて、データをmain.xlsm内のalldataシートにデータを転記し個人ファイルはセーブせずに閉じます。基本的にはエラーとならないはずです（テスト済みです）。（二重開きエラーが出てしまうため） →マクロファイル自身は、xlsmの拡張子ですので開かれることもないはずです。 VBAの Dir(FolderPath & "*.xlsx")の部分で無視しているためです。

mako1972

2020/07/28 02:44 編集

データ便にファイル一式(ZIPファイル)をUPしておきました。ダウンロードは一日です。ユーザー登録は不要です。同意ボタンをクリックするとファイルをダウンロードできます。必要でしたらダウンロードをお願いします（あやしいサイトではないです）。 https://www.datadeliver.net/receiver/file_box.do?fb=e6073c096ced422499ebc178a6b30786&rc=839a33fb16d6427b94511fe205e8284b&lang=ja

tokumeikibou162

2020/07/28 02:45

承知しました。何から何までありがとうございます。

tokumeikibou162

2020/07/28 03:06

エラーに関しては、私がxlsファイルに対して処理を実行しようとしたからでした。

mako1972

2020/07/28 03:11

なるほどこれでできそうでしょうか? サンプルですので色々修正作業があると思いますが参考になるといいですね。

tokumeikibou162

2020/07/28 03:57

そうですね、前回のと組み合わせればいけると思います。