画像データをファイルに
投稿日: 2011-07-28 /
カテゴリー:job
AccessからSQLServerに登録した画像データ(varbinary)を、ファイルで保存したいと思ったのですが、どうにもやり方が分かりません。
とりあえず今回は件数も少ないので、いったんAccessのイメージコントロールに表示して、それをファイルに保存するというやり方で対応することにしました。
DBからAccessのImageコントロールのPictureDataプロパティにセットし、それを外部ファイルに保存します。
元の画像が、BMP形式とBMP以外(PNG, JPG, GIF)のときで保存の仕方を変えないとだめみたいでした。
あと、BMPファイルは、元のファイルの色数によってbfOffBitsの値を調整する必要があるようです。
出来上がったファイルはペイントブラシでは開けるのですが他のソフトで開けなかったりしたので、ペイントブラシで一回開いて名前を付けて保存しないとだめかもしれません。
適当ですいません。とりあえず、藁レベルのメモということで。
標準モジュール内に記述。
Type BITMAPFILEHEADER bfType As String * 2 bfSize As Long bfReserved1 As Integer bfReserved2 As Integer bfOffBits As Long End Type
フォームにイメージコントールを「imgZumen」という名前で配置。
DBから画像データを取得して、Me.imgZumen.PictureDataにセットすると表示されるという前提で。
それをファイルに保存します。
以下をフォーム内に記述して、適当に呼び出してください。
' 元ファイルがBMP形式の場合 Private Sub SaveBMP() Dim cArray() As Byte ' 画像バイナリデータ Dim nFileNo As Integer ' ファイル番号 Dim i As Long Dim ln As Long Dim path As String Dim filenm As String Dim BMPfh As BITMAPFILEHEADER 'ヘッダ定義 path = Application.CurrentProject.path If path <> "" Then If Right$(path, 1) <> "\" Then path = path & "\" End If ' 画像データをファイルに書き出す nFileNo = FreeFile filenm = "output.bmp" cArray() = Me.imgZumen.PictureData With BMPfh .bfType = "BM" ' 固定 .bfSize = 14 + UBound(cArray) + 1 'ファイルサイズ .bfReserved1 = 0 ' 固定 .bfReserved2 = 0 ' 固定 '' .bfOffBits = 62 ' 白黒 .bfOffBits = 54 ' カラー(24ビット) End With Open path & filenm For Binary As #nFileNo Put #nFileNo, , BMPfh ' ヘッダ書き込み Put #nFileNo, , cArray() Close #nFileNo End Sub ' 元ファイルがBMP形式以外の場合 Private Sub SaveNotBMP() Dim cArray() As Byte ' 画像バイナリデータ Dim bArray() As Byte ' 画像バイナリデータ Dim nFileNo As Integer ' ファイル番号 Dim i As Long Dim ln As Long Dim path As String Dim filenm As String Dim sf As Long sf = 8 path = Application.CurrentProject.Path If path <> "" Then If Right$(path, 1) <> "\" Then path = path & "\" End If ' 画像データをファイルに書き出す nFileNo = FreeFile filenm = "output.png" ' とりあえず。何でもいいみたい。 bArray() = Me.imgZumen.PictureData ' Copy the embedded EMF - SKIP first 8 bytes ln = UBound(bArray) ReDim cArray(ln - sf) For i = sf To ln cArray(i - sf) = bArray(i) Next Open path & filenm For Binary As #nFileNo Put #nFileNo, , cArray() Close #nFileNo End Sub
先頭を8バイトずらすというのは、こちらのサイトを参考にしました。
http://msmvps.com/blogs/nateoliver/archive/2010/03/10/let-s-move-an-image-from-access-to-excel.aspx