1Dim OpenFileName As String
2 OpenFileName = Application.GetOpenFilename("Excelブック,*.xlsx")
3 If OpenFileName <> "False" Then
4 Workbooks.Open OpenFileName
5 End If
1Sub Filesentaku()
2 Dim myFile As Variant
34 myFile = Application.GetOpenFilename("エクセルファイル(*.xlsx),*.xls; *.xlsx")
56 If VarType(myFile) = vbBoolean Then
7 MsgBox "キャンセルされました"
8 Exit Sub
9 End If
1011 Dim dbConnect As New ADODB.Connection 'DB接続先情報
12 Dim dbRecordset As ADODB.Recordset 'DB接続先通信データ(SQL文を送り、結果を取得する)
1314 Dim ServerName As String 'サーバー名
15 Dim UserName As String 'ユーザー名
16 Dim Password As String 'パスワード
17 Dim ConnectServer As String '接続サーバ(大文字取得)
1819 Dim i As Long
20 Dim WB As String
21 Dim Regstno As String
22 Dim LoopCnt As Long
2324 Dim rs As ADODB.Recordset
25 Dim strSQL As String
2627 ServerName = Sheets(2).Cells(1, 2)
28 UserName = Sheets(2).Cells(2, 2)
29 Password = Sheets(2).Cells(3, 2)
30 ConnectServer = "SqlServer"
3132 dbConnect.Open "Provider=SQLOLEDB;Data Source=" & ServerName & ";User ID=" & UserName & ";Password=" & Password & ";"
33 WB = myFile
3435 Workbooks.Open fileName:=WB
3637 Sheets(1).Select
38 LoopCnt = Sheets(1).Cells(Rows.Count, 1).End(xlUp).row
3940 Application.ScreenUpdating = False
4142 For i = 2 To LoopCnt Step 1
43 Regstno = Sheets(1).Cells(i, 5).Value
4445 strSQL = "SELECT RELATIONNAMEKJ FROM T_RELATION WHERE REGISTNO = " & Regstno
4647 Set dbRecordset = dbConnect.Execute(strSQL)
4849 If dbRecordset.EOF = True Then
50 Sheets(1).Cells(i, 18) = "登録番号エラー"
51 Else
52 'データをセルへ設定
53 Sheets(1).Cells(i, 18) = dbRecordset.Fields(0).Value
54 End If
5556575859 dbRecordset.Close
60 Set dbRecordset = Nothing
6162 Next
6364 dbConnect.Close 'DB接続の破棄
65666768End Sub