[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『エクセルVBAでシートを読みこみＳＱＬ文に変換するには』（guaidao）
初めましてこんにちは。 下記に表示したコードを上手くつかい、フォルダ指定して、 先に表が用意されたエクセルファイルを読み込み 読み込まれたファイルを順番にＳＱＬファイルに変換したいのですが、 OpenやCopyなど色々ためしたものの中々上手くいきません。 このコードをどのようにコーティングすればできるようになるか 是非とも教えて頂けないでしょうか。 宜しくお願いします。
■変換のためのコード
Sub CreateTable()
'********************************************
' Create SQL
'********************************************
Dim TableName As String 'テーブル名称
Dim TableId As String 'テーブルＩＤ
Dim FieldName As String 'フィールドＩＤ
Dim FieldType As String 'フィールドタイプ
Dim FieldLength As String 'フィールド桁
Dim FieldPoint As String 'フィールド少数
Dim NotNull As String 'Not Null
Dim Default As String 'Default
Dim FieldCom As String '備考
Dim FileName As String 'SQL出力ファイル名(*.sql)
Dim SQLString As String
Dim i_sheet As Integer
Dim i_row As Integer
Dim i_col As Integer
Dim ValueToFind As Integer
Dim NotFound As Boolean
Dim SizeScale As String
Dim FieldNum As Integer
'*****************************************
' Create Table
'*****************************************
For i_sheet = 1 To Sheets.Count
Worksheets(Sheets(i_sheet).Name).Activate
TableName = Cells(4, 2).Value 'テーブル名称
MyPath = CurDir()
FileName = TableName + ".sql" 'テーブル名称.sqlというファイル名でsqlを作成する。
Open FileName For Output As #1
TableId = Cells(4, 7).Value 'テーブルＩＤ
SQLString = "Create Table " + TableId + " (" 'Create Table文開始
Print #1, SQLString
i_row = 7 'フィールド定義の開始行
FieldNum = 0
FieldName = Cells(i_row, 5).Value 'フィールドＩＤ
Do While FieldName <> ""
If i_row <> 7 Then
SQLString = SQLString + ","
Print #1, SQLString
End If
FieldType = Cells(i_row, 6).Value 'フィールド属性
If Len(FieldName) < 8 Then
SQLString = Chr(9) + FieldName + Chr(9) + Chr(9) + Chr(9) + FieldType
Else
If Len(FieldName) < 16 Then
SQLString = Chr(9) + FieldName + Chr(9) + Chr(9) + FieldType
Else
SQLString = Chr(9) + FieldName + Chr(9) + FieldType
End If
End If
If FieldType = "Nvarchar" Or FieldType = "Numeric" Or FieldType = "varchar" Or FieldType = "char" Then
FieldLength = Cells(i_row, 8) 'フィールド桁数
FieldPoint = Cells(i_row, 9) '少数点
If FieldPoint <> "" Then
SQLString = SQLString + "(" + FieldLength + "," + FieldPoint + ")"
Else
SQLString = SQLString + "(" + FieldLength + ")"
End If
Else
SQLString = SQLString + Chr(9)
End If
NotNull = Cells(i_row, 10).Value 'Null制約
If NotNull = "●" Then
SQLString = SQLString + Chr(9) + "Null"
Else
SQLString = SQLString + Chr(9) + "Not Null"
End If
Default = Cells(i_row, 11).Value 'Default
If Default <> "" Then
SQLString = SQLString + Chr(9) + "Default " + Default
End If
FieldNum = FieldNum + 1
i_row = i_row + 1
FieldName = Cells(i_row, 5).Value 'フィールドＩＤ
Loop
Print #1, SQLString
Print #1, ""
'**********************************************
' PrimaryKey
'**********************************************
i_row = 7 'フィールド定義の開始行
i_col = 3 'Index定義の開始列
sw1 = 0
FieldName = Cells(i_row, 5).Value 'フィールドＩＤ
Do While FieldName <> ""
If Cells(i_row, i_col).Value = "●" Then
If sw1 = 0 Then
SQLString = Chr(9) + "CONSTRAINT PMK_" + TableId + " PRIMARY KEY "
NONCLUSTERED ""
SQLString = SQLString + Chr(13) + Chr(10) + Chr(9) + "("
Print #1, SQLString
sw1 = 1
Else
SQLString = SQLString + ","
Print #1, SQLString
End If
SQLString = Chr(9) + FieldName
End If
i_row = i_row + 1
FieldName = Cells(i_row, 5).Value 'フィールドＩＤ
Loop
If sw1 = 1 Then
Print #1, SQLString
SQLString = Chr(9) + ")"
Print #1, SQLString
Print #1, ""
End If
'**********************************************
Print #1, ")"
Print #1, "Go"
Print #1, ""
'**********************************************
' Index
'**********************************************
i_row = 7 'フィールド定義の開始行
i_col = 4 'Index定義の開始列
sw1 = 0
FieldName = Cells(i_row, 5).Value 'フィールドＩＤ
Do While FieldName <> ""
If Cells(i_row, i_col).Value = "●" Then
If sw1 = 0 Then
SQLString = "Create Index " + TableId + "_INDEX_01" + " On " + TableId
SQLString = SQLString + Chr(13) + Chr(10) + Chr(9) + "("
Print #1, SQLString
sw1 = 1
Else
SQLString = SQLString + ","
Print #1, SQLString
End If
SQLString = Chr(9) + FieldName
End If
i_row = i_row + 1
FieldName = Cells(i_row, 5).Value 'フィールドＩＤ
Loop
If sw1 = 1 Then
Print #1, SQLString
SQLString = Chr(9) + ")"
Print #1, SQLString
Print #1, "Go"
Print #1, ""
End If
Print #1, "GRANT SELECT, INSERT, UPDATE, DELETE ON " + TableId + " TO db_user"
Print #1, "Go"
Close #1
Next i_sheet
End Sub
今回はこちらで修正しましたが、質問の内容が長いため、非常に見づらいです。 行頭に半角スペースを入れて書き込んでください。
と、アドバイスの方ですが、（全てを解読した訳ではないですが）気付いて点を
Do While FieldName <> ""
If i_row <> 7 Then
SQLString = SQLString + ","
Print #1, SQLString 'ここではPrintされている
End If
FieldType = Cells(i_row, 6).Value 'フィールド属性
If Len(FieldName) < 8 Then
SQLString = Chr(9) + FieldName + Chr(9) + Chr(9) + Chr(9) + FieldType
Else
If Len(FieldName) < 16 Then
SQLString = Chr(9) + FieldName + Chr(9) + Chr(9) + FieldType
Else
SQLString = Chr(9) + FieldName + Chr(9) + FieldType
End If
End If
'Printは？
If FieldType = "Nvarchar" Or FieldType = "Numeric" Or FieldType = "varchar" Or FieldType = "char" Then
FieldLength = Cells(i_row, 8) 'フィールド桁数
FieldPoint = Cells(i_row, 9) '少数点
If FieldPoint <> "" Then
SQLString = SQLString + "(" + FieldLength + "," + FieldPoint + ")"
Else
SQLString = SQLString + "(" + FieldLength + ")"
End If
Else
SQLString = SQLString + Chr(9)
End If
'Printは？
格納したSQLStringについてですが、 最初のIF文ではPrintしています。 ２つ目のIF文では格納して終了。 ３つ目のIF文で更に格納。 これでは２つ目で格納した意味がありません。 しかも、３つ目も格納のみで４つ目が存在しています。 所々でSQLStringのPrintがされてないようです。 この辺が原因では？
どのような原因でうまくいかないのか、記述していただけるともう少し詳しくアドバイスできるのですが･･･ (tomo)
tomoさんありがとうございます。 字が大きくて読みにくかったですね。 すいませんでした。
どのような原因で上手くいかないのか、 という事なのですが、 この変換コードの前に別のブックやシートを 読み込ませる記述などすれば、 そのまま変換処理がされると思いやってみたものの 結局開くだけ開いて終わりという状態で、 どうすればいいかが調べてもわからなかったのです。
例えば、Ａというブックにコードを記述し、 そのＡというブックそのもののシートに表などが書いてあれば きちんと変換されるのですが、 ＡというブックのコードからＢという別のブックのシートを 呼び出して 変換させようとすると、変換ができないという状況です。 この場合はどうすれば宜しいのでしょうか？
(guaidao)
下記のように変更して下さい。
1. Dim wb As Workbook
Dim ws As Worksheet
Dim opwb As String '2.(1)の場合、要らない
Dim wbnm As String '2.(1)の場合、要らない
Dim mypath As String
Dim sw1 As Long
上記追加
2.使い分けてください
(1) 他のブックについて、コードのブックと同じフォルダにあり、且つ、ブック名があらかじめ分かっている場合、
For Next の前に以下を追加
mypath = ThisWorkbook.Path
Workbooks.Open mypath & "\Book.xls" 'ブック名は適宜変更方
Set wb = Workbooks("Book.xls")
(For Next 内の mypath = CurDir() は要らない)
(2) ブックを選択する場合、For Next の前に以下を追加
opwb = Application.GetOpenFilename(Title:="ファイル開く", FileFilter:="Excel ファイル(*.xls),*.xls")
Workbooks.Open opwb
wbnm = Dir(opwb)
Set wb = Workbooks(wbnm)
(やっぱり、For Next 内の mypath = CurDir() は要らない)
3.For i_sheet = 1 To Sheets.Count
Set ws = wb.Sheets(i_sheet)
With ws
TableName = .Cells(4, 2).Value 'テーブル名称
FileName = TableName + ".sql" 'テーブル名称.sqlというファイル名でsqlを作成する。
～～中略～～
End With
Next i_sheet
Set wb = Nothing
Set ws = Nothing
と変更し、.Cells のように中略中のCell全てに"."を付ける。
以上のように変更して下さい。 検証はしていないので、エラーが発生したら、どの部分の何のエラーか教えてください。
ブック開閉に関する、エラー処理を考慮。
2.を下記に変更して下さい。
(1)
mypath = ThisWorkbook.Path
hantei = True
For Each wb In Workbooks
If wb.Name = "Book.xls" Then
hantei = False
Exit For
End If
Next wb
If hantei = True Then Workbooks.Open mypath & "\Book.xls"
Set wb = Workbooks("Book.xls")
(2)
opwb = Application.GetOpenFilename(Title:="ファイル開く", FileFilter:="Excel ファイル(*.xls),*.xls")
If opwb = "False" Then Exit Sub
wbnm = Dir(opwb)
hantei = True
For Each wb In Workbooks
If wb.Name = wbnm Then
hantei = False
Exit For
End If
Next wb
If hantei = True Then Workbooks.Open opwb
Set wb = Workbooks(wbnm)
Dim hantei As Boolean も追加して下さい。
ところで、最初に言った、Print の件は、そのままでいいのでしょうか？
(tomo)
まとめて書けって(^^ヾ Open FileName For Output As #1 コードのブックのパス＝カレントディレクトリではない可能性もあるので Open ThisWorkbook.Path & "\" & FileName For Output As #1 がいいかと･･･ (tomo)
ありがとうございます^^ ファイルを選ぶところまできちんとできました！
Cellsの前に"."をつけるとエラーがでます。 あと、printもちゃんとつけてみましたが、 やはり変換されず、 中身が空っぽのsqlファイルができてしまいます。 たぶん何か間違いがあると思うのですが、 セルの位置関係とか変えてみても 状況が打破できません^^;
(guaidao)
Open ThisWorkbook.Path & "\" & FileName For Output As #1
に変更してやると、 変換処理自体ができなくなる模様です。 色々と試してくださりありがとうございます！
(guaidao)
なぜでしょう？ ↓かなりコードを省略しましたが、ファイルがちゃんと作成されますか？ (私の方では動作確認できました)
Sub CreateTable()
'********************************************
' Create SQL
'********************************************
Dim TableName As String 'テーブル名称
Dim TableId As String 'テーブルＩＤ
Dim FieldName As String 'フィールドＩＤ
Dim FieldType As String 'フィールドタイプ
Dim FieldLength As String 'フィールド桁
Dim FieldPoint As String 'フィールド少数
Dim NotNull As String 'Not Null
Dim Default As String 'Default
Dim FieldCom As String '備考
Dim FileName As String 'SQL出力ファイル名(*.sql)
Dim SQLString As String
Dim i_sheet As Integer
Dim i_row As Integer
Dim i_col As Integer
Dim ValueToFind As Integer
Dim NotFound As Boolean
Dim SizeScale As String
Dim FieldNum As Integer
Dim wb As Workbook
Dim ws As Worksheet
Dim opwb As String
Dim wbnm As String
Dim mypath As String
Dim sw1 As Long
Dim hantei As Boolean
'*****************************************
' Create Table
'*****************************************
mypath = ThisWorkbook.Path
hantei = True
For Each wb In Workbooks
If wb.Name = "Book1.xls" Then
hantei = False
Exit For
End If
Next wb
If hantei = True Then Workbooks.Open mypath & "\Book1.xls"
Set wb = Workbooks("Book1.xls")
For i_sheet = 1 To Sheets.Count
Set ws = wb.Sheets(i_sheet)
With ws
TableName = .Cells(4, 2).Value 'テーブル名称
FileName = TableName + ".sql" 'テーブル名称.sqlというファイル名でsqlを作成する。
Open ThisWorkbook.Path & "\" & FileName For Output As #1
TableId = .Cells(4, 1).Value 'テーブルＩＤ
SQLString = "Create Table " + TableId + " (" 'Create Table文開始
Print #1, SQLString
Close #1
End With
Next i_sheet
Set wb = Nothing
Set ws = Nothing
End Sub
(tomo)
その記述でtomoさんは動作が確認されたのですか？ 私はエラーになっていましました^^; アプリテーション定義またはオブジェクト定義のエラーと 出てしまいます。 同じエクセルのはずなのにおかしいですね…
(guaidao)
省略版の方ですが、Dimも含め、最初から最後までコピペしたのですよね？ 参照設定等の必要もないのですが･･･ TableName = .Cells(4, 2).Value ここで、エラーですか？ (tomo)
どうやらこちらでは 短いコード全体がエラーみたいなので 原因がよくわかりません。 直せるところは直したのですが。
ただ、もとの長いコードだと ちゃんと動いてsqlファイルだけ作りだします。 ちなみにできたsqlファイルの中身は
Create Table ( Create Table (
) Go
GRANT SELECT, INSERT, UPDATE, DELETE ON TO db_user Go
上記のようになっています。 本来なら数値や名前が入力されているはずなんですが、 tomoさんのほうで動作が確認されるなら、やはり私のほうに 問題があるということですね。
(guaidao)
guaidaoさん code中の "+" を & に変えてみて下さい。 + だと 変数に数値が入った場合 加算 してしまいます。 sql は String なので & で繋ぐべきでしょう。 guaidaoさんのコードのことです。 (seiya)
seiyaさんの指摘は反映していませんが、 一応、全文載せます。 標準モジュールにコピペで、一度保存してから使用して下さい。 (短いコードの方ですが、新規ブックにコピペしたのなら、保存せず実行させたのでは？）
Sub CreateTable()
'********************************************
' Create SQL
'********************************************
Dim TableName As String 'テーブル名称
Dim TableId As String 'テーブルＩＤ
Dim FieldName As String 'フィールドＩＤ
Dim FieldType As String 'フィールドタイプ
Dim FieldLength As String 'フィールド桁
Dim FieldPoint As String 'フィールド少数
Dim NotNull As String 'Not Null
Dim Default As String 'Default
Dim FieldCom As String '備考
Dim FileName As String 'SQL出力ファイル名(*.sql)
Dim SQLString As String
Dim i_sheet As Integer
Dim i_row As Integer
Dim i_col As Integer
Dim ValueToFind As Integer
Dim NotFound As Boolean
Dim SizeScale As String
Dim FieldNum As Integer
Dim wb As Workbook
Dim ws As Worksheet
Dim opwb As String
Dim wbnm As String
Dim mypath As String
Dim sw1 As Long
Dim hantei As Boolean
'*****************************************
' Create Table
'*****************************************
mypath = ThisWorkbook.Path
hantei = True
For Each wb In Workbooks
If wb.Name = "Book1.xls" Then
hantei = False
Exit For
End If
Next wb
If hantei = True Then Workbooks.Open mypath & "\Book1.xls"
Set wb = Workbooks("Book1.xls")
' opwb = Application.GetOpenFilename(Title:="ファイル開く", FileFilter:="Excel ファイル(*.xls),*.xls") ' If opwb = "False" Then Exit Sub ' wbnm = Dir(opwb) ' hantei = True ' For Each wb In Workbooks ' If wb.Name = wbnm Then ' hantei = False ' Exit For ' End If ' Next wb ' If hantei = True Then Workbooks.Open opwb ' Set wb = Workbooks(wbnm)
For i_sheet = 1 To Sheets.Count
Set ws = wb.Sheets(i_sheet)
With ws
TableName = .Cells(4, 2).Value 'テーブル名称
FileName = TableName + ".sql" 'テーブル名称.sqlというファイル名でsqlを作成する。
Open ThisWorkbook.Path & "\" & FileName For Output As #1
TableId = .Cells(4, 7).Value 'テーブルＩＤ
SQLString = "Create Table " + TableId + " (" 'Create Table文開始
Print #1, SQLString
i_row = 7 'フィールド定義の開始行
FieldNum = 0
FieldName = .Cells(i_row, 5).Value 'フィールドＩＤ
Do While FieldName <> ""
If i_row <> 7 Then
SQLString = SQLString + ","
Print #1, SQLString
End If
FieldType = .Cells(i_row, 6).Value 'フィールド属性
If Len(FieldName) < 8 Then
SQLString = Chr(9) + FieldName + Chr(9) + Chr(9) + Chr(9) + FieldType
Else
If Len(FieldName) < 16 Then
SQLString = Chr(9) + FieldName + Chr(9) + Chr(9) + FieldType
Else
SQLString = Chr(9) + FieldName + Chr(9) + FieldType
End If
End If
If FieldType = "Nvarchar" Or FieldType = "Numeric" Or FieldType = "varchar" Or FieldType = "char" Then
FieldLength = .Cells(i_row, 8) 'フィールド桁数
FieldPoint = .Cells(i_row, 9) '少数点
If FieldPoint <> "" Then
SQLString = SQLString + "(" + FieldLength + "," + FieldPoint + ")"
Else
SQLString = SQLString + "(" + FieldLength + ")"
End If
Else
SQLString = SQLString + Chr(9)
End If
NotNull = .Cells(i_row, 10).Value 'Null制約
If NotNull = "●" Then
SQLString = SQLString + Chr(9) + "Null"
Else
SQLString = SQLString + Chr(9) + "Not Null"
End If
Default = .Cells(i_row, 11).Value 'Default
If Default <> "" Then
SQLString = SQLString + Chr(9) + "Default " + Default
End If
FieldNum = FieldNum + 1
i_row = i_row + 1
FieldName = .Cells(i_row, 5).Value 'フィールドＩＤ
Loop
Print #1, SQLString
Print #1, ""
'**********************************************
' PrimaryKey
'**********************************************
i_row = 7 'フィールド定義の開始行
i_col = 3 'Index定義の開始列
sw1 = 0
FieldName = .Cells(i_row, 5).Value 'フィールドＩＤ
Do While FieldName <> ""
If .Cells(i_row, i_col).Value = "●" Then
If sw1 = 0 Then
'
'ここが、よく分からないのでご自身で修正して下さい。
' SQLString = Chr(9) + "CONSTRAINT PMK_" + TableId + " PRIMARY KEY "
'
' NONCLUSTERED "" '←???
'
'
SQLString = SQLString + Chr(13) + Chr(10) + Chr(9) + "("
Print #1, SQLString
sw1 = 1
Else
SQLString = SQLString + ","
Print #1, SQLString
End If
SQLString = Chr(9) + FieldName
End If
i_row = i_row + 1
FieldName = .Cells(i_row, 5).Value 'フィールドＩＤ
Loop
If sw1 = 1 Then
Print #1, SQLString
SQLString = Chr(9) + ")"
Print #1, SQLString
Print #1, ""
End If
'**********************************************
Print #1, ")"
Print #1, "Go"
Print #1, ""
'**********************************************
' Index
'**********************************************
i_row = 7 'フィールド定義の開始行
i_col = 4 'Index定義の開始列
sw1 = 0
FieldName = .Cells(i_row, 5).Value 'フィールドＩＤ
Do While FieldName <> ""
If .Cells(i_row, i_col).Value = "●" Then
If sw1 = 0 Then
SQLString = "Create Index " + TableId + "_INDEX_01" + " On " + TableId
SQLString = SQLString + Chr(13) + Chr(10) + Chr(9) + "("
Print #1, SQLString
sw1 = 1
Else
SQLString = SQLString + ","
Print #1, SQLString
End If
SQLString = Chr(9) + FieldName
End If
i_row = i_row + 1
FieldName = .Cells(i_row, 5).Value 'フィールドＩＤ
Loop
If sw1 = 1 Then
Print #1, SQLString
SQLString = Chr(9) + ")"
Print #1, SQLString
Print #1, "Go"
Print #1, ""
End If
Print #1, "GRANT SELECT, INSERT, UPDATE, DELETE ON " + TableId + " TO db_user"
Print #1, "Go"
Close #1
End With
Next i_sheet
Set wb = Nothing
Set ws = Nothing
End Sub
一応、ファイル作成とセルの転記は出来たのですが･･･
すいません。 今日は新歓なので、もう帰ります。
(tomo)
seiyaさん御指摘ありがとうございます^^
tomoさん忙しい中ありがとうございました！ 結局エラーが出てしまいできませんでしたが^^; もう少しで何とかなるような気がするので、 tomoさんにブックを選べるように変更して頂いた 私のコードで粘ってみます。
(guaidao)
リンクだけ貼っておきます。 [[20070918130314]]『解決？！エクセルVBAでエクセルファイル読み込ませてSQLファイルに転記させるには』（guaidao）
(HANA)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.