Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

2273 / 9994

←次へ　｜　前へ→


	【10998】字数(Byte数)制限？

よっぴ - 09/2/12(木) 13:02 -


	引用なし

	パスワード

　いつもとても勉強にさせて頂いてます。
今回初の投稿になりますが、何卒よろしくお願いいたします。

■状況
(スペック)
WinXP
Access2003
Excel2003

(目的)
複数のExcelファイル(任意指定、複数指定可)のシート(固有名指定)をアクセスにインポートする。

(経過)
1.[GetOpenFileName]を呼び出し、ダイアログからファイルパスを任意・複数取得
2.Excel.Application.WorkBook.Openでエクセルファイルをオープン
3.DAOでAccessTableへ保存
*2.でエクセルの保護をしているため[TransferSpreadSheet]ﾒｿｯﾄﾞは使用不可

(問題?困っていること)
1.のダイアログから複数のファイルを選択した場合、なぜか『8188』Byte以上になるとそれ以降が削除されます。

以下記述内容です。*エラー処理は省いてます。

■[GetOpenFileName]の標準ﾓｼﾞｭｰﾙ

Public Enum enmGetFileNameView
gfnViewDetail
gfnViewPreview
gfnViewPropewty
gfnViewList
gfnViewLargeIcons
gfnViewSmallIcons
gfnViewTiles = 8
End Enum

Public Enum enmGetFileNameFlags
gfnFlagsoverWritePrompt = &H1
gfnFlagsSetCurDir = &H4
gfnFlagsAllowMultiSelect = &H8
gfnFlagsSelectFolder = &H20
gfnFlagsEnableView = &H40
End Enum

Public Enum enmGetFileNameFOpen
gfnFOpenOpen = -1
gfnFOpenSaveAs = 0
End Enum

Function wh_GetFileName( _
　　Optional hwndOner As Long, _
　　Optional AppName As String, _
　　Optional DlgTitle As String, _
　　Optional OpenTitle As String, _
　　Optional FILE As String, _
　　Optional InitialDir As String, _
　　Optional FILTER As String, _
　　Optional FilterIndex As Long, _
　　Optional View As enmGetFileNameView, _
　　Optional flags As enmGetFileNameFlags, _
　　Optional fOpen As enmGetFileNameFOpen _
　　) As String

Const ENABLE_WIZHOOK = 51488399
Const DISABLE_WIZHOOK = 0
Dim strFILE As String
Dim lngResult As Long

If (hwndOwner = 0) Then hwndOwner = Application.hWndAccessApp
If (AppName = "") Then AppName = Application.Name
strFILE = FILE
If (FILTER = "") Then FILTER = "すべてのファイル(*.*)|*.*"
WizHook.Key = ENABLE_WIZHOOK

lngResult = WizHook.GetFileName( _
　　hwndOwner, _
　　AppName, _
　　DlgTitle, _
　　OpenTitle, _
　　strFILE, _
　　InitialDir, _
　　FILTER, _
　　FilterIndex, _
　　View, _
　　flags, _
　　fOpen)

WizHook.Key = DISABLE_WIZHOOK

wh_GetFileName = strFILE
　　
End Function

■実行プロシージャ
Sub sample()

'---ファイルの取得処理---
Const DLG_TITLE = "データインポート"
Const FILTER_ = "Excelファイル(*.xls)|*.xls"
Dim INITIAL_DIR As String

INITIAL_DIR = CurrentProject.Path

Dim strFILE As String
strFILE = wh_GetFileName(, , _
　　DLG_TITLE, , , INITIAL_DIR, FILTER_, _
　　 , , gfnFlagsAllowMultiSelect, _
　　gfnFOpenOpen)
If strFILE = vbNullString Then
Exit Sub
End If

MsgBox LenB(strFILE) '←ここで問題であろうByte数を調べました。
Debug.Print strFILE '←一応表示もしてみました。

DoCmd.Hourglass True

'---データの保存処理---
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim vntList As Variant
Dim CNT As Long
Dim IDX As Long

''---保存先の設定---
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(Name:="T_Test", Type:=dbOpenTable)
Set xls = CreateObject("Excel.Application")

''---ファイル取得情報を区切る---
Dim ret, myFILE
ret = Split(strFILE, vbTab)

For Each myFILE In ret

''---エクセルファイルオープン---
　　Set wkb = xls.Workbooks.Open(FileName:=myFILE, ReadOnly:=True _
　　　　　　　, Password:="pass", WriteResPassword:="pass")

　　With wkb.Worksheets("Sheet1").Range("A1").CurrentRegion

''---データが1行でない場合---
　　If Not (.Rows.Count = 1) Then
　　
　　　　Let vntList = .Resize(.Rows.Count - 1).offset(1, 0).Value
　　
'''---レコードの保存(選択範囲内ループ)---
　　　　For CNT = LBound(vntList, 1) To UBound(vntList, 1)
　　　　　　rst.AddNew
　　　　
　　　　　　For IDX = LBound(vntList, 2) To UBound(vntList, 2)
　　　　　　　　Let rst.Fields(IDX - 1).Value = vntList(CNT, IDX)
　　　　　　Next
　　　　
　　　　　　rst.Update
　　　 Next
　　End If

　　End With

Next myFILE

''---解放処理---
wkb.Close SaveChanges:=False
xls.Quit
Set wkb = Nothing
Set xls = Nothing

rst.Close
dbs.Close
Set rst = Nothing
Set dbs = Nothing

DoCmd.Hourglass False

MsgBox "正常にインポートされました。"

End Sub

以上です。

ヘルプを見てみましたが、String型で2.0GB以上の格納が可能とあるので「？」です。
恐れ入りますがよろしくお願いいたします。

1,597 hits

▼

【10998】字数(Byte数)制限？ よっぴ 09/2/12(木) 13:02