|
▼koike さん:
こんにちは。
>当方、以下の環境です。
>Windows2000 Professional SP4
>Access 2000
Ac2002より、FileDialogオブジェクトがサポートされて
ダイアログ表示を実装しやすくなったのですが、Ac2000ですと残念ながら使用できません。
そこで下記の様な方法が考えられます。
1.WindowsAPIを使う
こちらは Windows の機能を Access から呼び出すものです。
Accessのバージョンに左右されにくいのですが、
API特有の表現が出てくるので慣れるまでに時間が掛かるかもしれません。
'----------------------------------------------------------------------
Option Compare Database
Option Explicit
Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long '構造体のサイズ
hwndOwner As Long '親ウィンドウのハンドル
hInstance As Long 'モジュールのインスタンスハンドル
lpstrFilter As String 'VBのファイルパターン
lpstrCustomFilter As String 'カスタムフィルタ
nMaxCustFilter As Long '同バイト数
nFilterIndex As Long 'フィルタのインデックス
lpstrFile As String 'フルパス名を受取るバッファ
nMaxFile As Long '同バイト数
lpstrFileTitle As String 'ファイル名を受取るバッファ
nMaxFileTitle As Long '同バイト数
lpstrInitialDir As String '初期ディレクトリ名
lpstrTitle As String 'ダイアログボックスのキャプションタイトル
flags As Long '動作を指定する定数の組合せ
nFileOffset As Integer 'フルパス中のファイル名までのオフセット
nFileExtension As Integer '同 拡張子までのオフセット
lpstrDefExt As String 'デフォルトの拡張子
lCustData As Long 'フックプロシージャに渡すデータ
lpfnHook As Long 'フックプロシージャOFNHookprocへのポインタ
lpTemplateName As String 'テンプレートリソース名
End Type
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_EXPLORER = &H80000
'----------------------------------------------------------------------
Private Sub コマンドボタン_Click()
Dim tOpenFileName As OPENFILENAME
Dim lngRet As Long
Dim strFileName As String
With tOpenFileName
.lStructSize = Len(tOpenFileName)
.hwndOwner = Me.Hwnd
.lpstrFilter = "Excelファイル(*.xls)" & vbNullChar & "*.xls"
.lpstrFile = strFileName & String$(256, Chr$(0))
.nMaxFile = 256
.lpstrFileTitle = String$(256, Chr$(0))
.nMaxFileTitle = 256
.lpstrInitialDir = "C:\"
.lpstrTitle = "名前を付けて保存"
.flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or _
OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT
End With
lngRet = GetSaveFileName(tOpenFileName)
If lngRet = 0 Then
strFileName = ""
Exit Sub
Else
strFileName = Left$(tOpenFileName.lpstrFile, _
InStr(tOpenFileName.lpstrFile, vbNullChar) - 1)
End If
MsgBox strFileName
End Sub
'----------------------------------------------------------------------
Private Sub コマンドボタン_Click()を適宜変更された後
フォームに上記コードを記載して実行されてみて下さい。
後は こちらで得られた strFileName の値と
TransferSpreadsheet メソッドと組み合わせる事になります。
2.WizHookオブジェクトを使う
こちらは非公開オブジェクトであり動作の保証はできませんが、
Ac2000に用意されている機能です。
こちらについてはYU-TANGさんのサイトで詳しく触れられているので
目を通されてみてはいかがでしょうか。
YU-TANG's MS-Access Discoveryさん
[ファイルを開く] ダイアログを表示する方法
http://x7net.com/~access/AcTipsGetFileName.html
(GetFileName メソッドの引数 を変えることにより[ファイルを保存] も行えます。)
|
|