Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Private Sub cmdSqlDumpFile_Click()
On Error GoTo Err_cmdSqlDumpFile_Click
Dim rs As Recordset
Dim db As Database
Dim i As Integer
Dim txtDumpName As String
Dim strTableName As String
Dim strHeader As String
Dim strDataLine As String
strTableName = txtTableName
If strTableName = "" Then
MsgBox "Please enter the name of the table which contains the data to dump into an SQL file"
Else
'Get the desired file name from user input
txtDumpName = InputBox("Please enter the desired name of the SQL dump file... ")
If txtDumpName = "" Then
MsgBox "The value you have entered is invalid...please try again"
Exit Sub
Else
Set db = CurrentDb
Set rs = db.OpenRecordset(strTableName)
rs.MoveLast
rs.MoveFirst
'prepare values for the Header
Dim tdfTable As TableDef
Dim iNumFields As Integer
Dim strFieldNames() As String
ReDim strFieldNames(rs.Fields.Count) 'declare the strFieldnames array with the correct number of values for the table
For iNumFields = 0 To (rs.Fields.Count - 1)
strFieldNames(iNumFields) = rs.Fields(iNumFields).Name
Next iNumFields
'create the header
strHeader = "CREATE TABLE " & strTableName & "(" & vbCrLf
For iNumFields = 0 To (rs.Fields.Count - 1)
strHeader = strHeader & strFieldNames(iNumFields) & " varchar(" & rs.Fields(iNumFields).Size & ") NOT NULL"
If iNumFields < (rs.Fields.Count - 1) Then
strHeader = strHeader & "," & vbCrLf
Else
strHeader = strHeader & "); " & vbCrLf
End If
Next iNumFields
'open the text file and begin writing to it line by line
Open ("C:\Documents and Settings\" & Environ("username") & "\Desktop\" & txtDumpName & ".sql") For Output As #1
Print #1, strHeader
For i = 1 To rs.RecordCount
strDataLine = "INSERT INTO " & strTableName & " VALUES ("
For iNumFields = 0 To (rs.Fields.Count - 1)
strDataLine = strDataLine & "'" & rs.Fields(iNumFields) & "'"
If iNumFields < (rs.Fields.Count - 1) Then
strDataLine = strDataLine & ", "
Else
strDataLine = strDataLine & ");" & vbCr
End If
Next iNumFields
Print #1, strDataLine
rs.MoveNext
Next i
'close the text file
Close #1
rs.Close
Set db = Nothing
End If
End If
MsgBox "File Creation complete..."
Exit_cmdSqlDumpFile_Click:
Close #1 'make sure the text file is closed or incur more errors
Exit Sub
Err_cmdSqlDumpFile_Click:
MsgBox Err.Description
Resume Exit_cmdSqlDumpFile_Click
End Sub