Common file saved to database, write disk program code from database

Source: Internet
Author: User
Tags date exit error handling goto save file
Program | data | Database common file Save to database, write disk program code from database----20040809
These days I am on vacation, just have time to continue to write Mycodelibrary version 1.5, this evening just write to file and database to take out the module, in the forum this problem see more, so I hereby expose this part of the code, For the need of reference use. Although the code can be used completely, but still need to do some wrong aspects of processing.

' Welcome you to download the use of this code, this code by the program Pacific to provide download learning
Statement
' 1. All the code of the site to the original author all the copyright, if you use the site download the source code
' Cause all disputes (consequences) and the site has nothing to do, please respect the original author of the Labor achievements!
' 2. If the site in the code has infringed on your contact with the webmaster, the webmaster will promptly correct.
' China Code network: http://www.daima.com.cn
' Program Pacific: http://www.5ivb.net
' Email:dapha@etang.com
' Copyright 2001-2005 by www.5ivb.net
' Finishing Time: 2004-8-9 3:32:48
Option Explicit
Public objconn as New adodb.connection
Public m_connstring As String
Private Function Exists (ByVal str_filename As String, _
ByVal int_val As Vbfileattribute) As Boolean
'--------------------------------------------------------------------------------
' Project:mycodelibrary 1.5
' Procedure:exists
' Description: [to determine whether a file or directory exists]
' Created By:ronggang (zhouronggang@163.com)
' Date-time:2004-8-9-2:31:45
'
' Parameters:str_filename (String)
' Int_val (Vbfileattribute)
'--------------------------------------------------------------------------------
On Error Resume Next
If Len (str_filename) = 0 Then
exists = False
Exit function
End If
If Int_val <> vbdirectory then ' if not directory
' If NULL indicates that the file does not exist
If Dir (str_filename) = "" Then
exists = False
Else
exists = True
End If
Else
If Dir (str_filename, vbdirectory) = "" Then
exists = False
Else
exists = True
End If
End If
End Function
Public Sub Binvalue (ByVal strFileName As String, ByRef objfield as field)
'--------------------------------------------------------------------------------
' Project:mycodelibrary 1.5
' Procedure:binvalue
' Description: [Save file to database]
' Created By:wangfeng
' Date-time:2004-8-9-2:20:37
'
' Parameters:strfilename (String)
' Objfield (field)
'--------------------------------------------------------------------------------
' This method requires error handling to prevent the file from being opened
Dim objstream As Stream
If not EXISTS (strFileName, vbnormal) Then ' throws an exception if the file is not saved
Err.Raise 50001, "DBFile", "file does not exist!"
Exit Sub
End If
Set objstream = new ADODB.stream
With Objstream
. Type = adTypeBinary
. Open
. LoadFromFile strFileName
Objfield.value =. Read
End With
Set objstream = Nothing
End Sub
Public Function Binvalue2file (ByVal strFileName As String, ByRef objfield as field, optional overwrite As Boolean = False) As Boolean
'--------------------------------------------------------------------------------
' Project:mycodelibrary 1.5
' Procedure:binvalue2file
' Description: [Save binary data in database as file]
' Created By:wangfeng
' Date-time:2004-8-9-2:22:33
'
' Parameters:strfilename (string) destination file
' Objfield (field) data fields name
' Overwrite (Boolean = false) overwrites existing files
' True to overwrite false (default) save when not present
'--------------------------------------------------------------------------------
On Error Goto Errorhander
Dim objstream As Stream
Dim returnmsg As VbMsgBoxResult
Set objstream = new ADODB.stream
With Objstream
. Type = adTypeBinary
. Open
. Write Objfield.value
If Overwrite then
. SaveToFile strFileName, Adsavecreateoverwrite
Else
. SaveToFile strFileName, Adsavecreatenotexist
End If
End With
Binvalue2file = True ' Save success return True
101:
Set objstream = Nothing
Exit function
Errorhander:
Binvalue2file = False
Goto 101
End Function
Public Function GetFileName (ByVal strpathfilename) As String
Dim IPOs As Long
IPOs = Vba.instrrev (Strpathfilename, "\")
GetFileName = Mid (Strpathfilename, IPOs + 1)
End Function
Public function getpathname (optional Strpathname As String) as String
' sFileName = Mid (GetPathName, IPOs + 1)
Dim IPOs As Long
IPOs = Vba.instrrev (Strpathname, "\")
GetPathName = Mid (Strpathname, 1, IPOs)
End Function



Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.