VBA对DB操作方法范例文档格式.docx

VBA对DB操作方法范例文档格式.docx

《VBA对DB操作方法范例文档格式.docx》由会员分享，可在线阅读，更多相关《VBA对DB操作方法范例文档格式.docx（41页珍藏版）》请在冰豆网上搜索。

DimvRetAsLong'

戻り値

DimobjRecsetAsOraDynaset

DimmyDictionaryAsObject

DimiMsgRetAsInteger

DimsSortKeyAsString

DimlCreateSheetsFAsLong

DimlMultiFlgAsLong

DimsTableName（9）AsString

OnErrorGoToERR_SUB

Application.ScreenUpdating=False

'

更新件数の取得

gsMAX_RECORD=ThisWorkbook.Worksheets（"

接続文字列"

）.Range（"

B4"

）.Value

----------------------------------------------

マスタ反映シートのチェック

シートオブジェクト生成

SetobjSheet=ThisWorkbook.Worksheets（"

マスタ反映"

）

LCHADDオーダー番号の取得

order_NUM=Trim（objSheet.Range（"

H6"

）.Value）

必須項目のチェック

Iforder_NUM="

"

Then

MsgBox"

オーダー番号を入力して下さい。

GoToEXIT_SUB

EndIf

IfTrim（objSheet.Range（"

C25"

）.Value）="

取り込むテーブルを入力して下さい。

lMultiFlg=0

D25"

）.Value）<

>

"

sTableName（0）=Trim（objSheet.Range（"

sTableName

（1）=Trim（objSheet.Range（"

sTableName

（2）=Trim（objSheet.Range（"

E25"

sTableName（3）=Trim（objSheet.Range（"

F25"

sTableName（4）=Trim（objSheet.Range（"

G25"

sTableName（5）=Trim（objSheet.Range（"

H25"

sTableName（6）=Trim（objSheet.Range（"

I25"

sTableName（7）=Trim（objSheet.Range（"

J25"

sTableName（8）=Trim（objSheet.Range（"

K25"

sTableName（9）=Trim（objSheet.Range（"

L25"

lMultiFlg=1

Else

反映するシート名を取得

sWorksheetNm=Trim（objSheet.Range（"

シートオブジェクト解放

SetobjSheet=Nothing

IflMultiFlg=0Then

シートチェック（存在する場合は作成）

lCreateSheetsF=0

IfchkSheet（sWorksheetNm）=TrueThen

iMsgRet=MsgBox（"

既にシートが存在しています。

新規に作成して宜しいですか？

vbQuestion+vbYesNoCancel）

IfiMsgRet=vbYesThen

WithThisWorkbook

Application.DisplayAlerts=False

.Worksheets（sWorksheetNm）.Delete

Application.DisplayAlerts=True

EndWith

ElseIfiMsgRet=vbNoThen

lCreateSheetsF=1

ExitSub

複数テーブルを読込みますが、宜しいですか？

vbQuestion+vbYesNo）

DB接続

vRet=DBConnect（）

SelectCasevRet

Case-1

DB接続エラー"

Case-2

接続文字列エラー"

EndSelect

原紙シートのコピー

Fori=0ToUBound（sTableName）

IfTrim（sTableName（i））<

IfchkSheet（sTableName（i））=FalseThen

SetobjCopy=ThisWorkbook.Worksheets（"

原紙"

objCopy.Visible=True

最終シートオブジェクトを取得

SetobjLastSheet=.Worksheets（.Worksheets（.Worksheets.Count）.Name）

シート作成

objCopy.CopyAfter:

=objLastSheet

SetobjLastSheet=Nothing

objCopy.Visible=False

SetobjCopy=Nothing

シート名設定

ThisWorkbook.ActiveSheet.Name=sTableName（i）

作成したシートへの反映

SetobjCopy=ThisWorkbook.Worksheets（sTableName（i））

--データ設定--

テーブル名

objCopy.Range（"

B1"

）.Value=sTableName（i）

データ取得

vRet=getDBInfo（sTableName（i）,objRecset,myDictionary）

IfvRet<

0Then

IfobjRecset.RecordCount>

65536Then

データ件数が、65536件以上あります。

条件を絞って検索して下さい。

シートクリア

objCopy.Range（objCopy.Cells（5,2）,objCopy.Cells（gsMAX_RECORD,objRecset.Fields.Count+3））.ClearContents

カラム表示

lSetCnt=3

objCopy.Activate

Forj=0ToobjRecset.Fields.Count-1

PKチェック

IfmyDictionary.Exists（CStr（objRecset.Fields（j）.Name））=TrueThen

objCopy.Cells（1,lSetCnt）.Value="

PK"

objCopy.Cells（2,lSetCnt）.Value=objRecset.Fields（j）.Name'

カラム名

objCopy.Cells（3,lSetCnt）.Value=objRecset.Fields（j）.Name'

objCopy.Cells（4,lSetCnt）.Value=ConvType（objRecset.Fields（j）.OraIDataType）'

タイプ

lSetCnt=lSetCnt+1

Nextj

データ表示

vRet=DispData（objCopy,objRecset）

SetobjRecset=Nothing

Nexti

CallDBClose

ThisWorkbook.Worksheets（sTableName（0））.Activate

Application.ScreenUpdating=True

ERR_SUB:

MsgBoxErr.Number&

:

&

Err.Description

EXIT_SUB:

DB切断

PrivateFunctionchkSheet（ByValsSheetsNameAsString）AsBoolean

DimiAsLong'

反映シートが存在するかチェック

chkSheet=False

Fori=1To.Worksheets.Count

If.Worksheets（i）.Name=sSheetsNameThen

chkSheet=True

ExitFor

EndFunction

PrivateSubcmdGetInfo_Click（）

DimsSQLAsString'

SQL文

DimsInterfaceIdAsString'

インターフェイスID

vRet=DBConnect_Com（）

基本情報取得

IfTrim（objSheet.Cells（6,3））<

sInterfaceId=Split（Trim（objSheet.Cells（6,3））,"

：

）（0）

sInterfaceId="

sSQL="

SELECTIF_TABLE_NAMEFROMTB_BLS_META_INFOWHEREINTERFACE_ID='

sInterfaceId&

GROUPBYIF_TABLE_NAME"

vRet=SelectData（sSQL,objRecset）

GoToERR_SUB

10Then

データ件数が、10件以上あります。

ご確認下さい。

シートオブジェクト初期化

Fori=3To12

objSheet.Cells（25,i）="

objSheet.Cells（41,i）="

Forj=0ToobjRecset.RecordCount-1

objSheet.Cells（25,j+3）=objRecset.Fields（objRecset.Fields（0）.Name）

objSheet.Cells（41,j+3）=objSheet.Cells（25,j+3）

objRecset.MoveNext

PrivateSubcmdSQL_Click（）

DimobjExcelAsObject'

Excelオブジェクト

DimsITEM_SQLAsString'

INSERTのSQL（ITEM部分）

DimsVALUE_SQLAsString'

INSERTのSQL（VALUE部分）

DimsMAIN_SQLAsString'

INSERTのSQL（結合）

DimlColCntAsLong'

カラムカウンタ

ファイル作成オブジェクト

DimsFilePathAsString'

出力パス

DimobjFsAsObject'

ファイルシステムオブジェクト

DimobjFileAsObject'

ファイルオブジェクト

DimsTitleAsString'

タイトル

DimvRetAsLong

DimsDELETSQLAsString

DimsDelWhereAsString

DimsUPDATESQLAsString

DimsUpdWhereAsString

DimobjRegDataAsObject'

登録済テーブル

DimlUpCntAsLong

CallDBBeginTrans

オーダー番号の取得

order_NUM=Trim（ThisWorkbook.Worksheets（"

SetobjRegData=CreateObject（"

Scripting.Dictionary"

lUpCnt=0

存在するシート分データを作成する。

登録テーブル指定がある場合は指定テーブルのみ登録する。

IfTrim（.Worksheets（"

C41"

Or_

Trim（.Worksheets（"

D41"

E41"

F41"

G41"

H41"

I41"

J41"

K41"

L41"

.Worksheets（i）.NameAnd_

.Worksheets（i）.NameThen

GoToNO_DATA

対象シートオブジェクト生成

SetobjExcel=.Worksheets（.Worksheets（i）.Name）

テーブルクリア処理

IfTrim（objExcel.Cells（3,2）.Value）<

vRet=ExecuteData（"

deletefrom"

Trim（objExcel.Cells（1,2