Imorting xml of attachment field...

F

Fox

I have a procedure to back up data in certain tables and create xml files of
the data and this seems to be working ...
The restore is failing on the attachment fields which have jpegs as
attachments.
Does anyone have any experience with the back up and restore of data from
tables in 2007? Here is the code..for the back up and then the restore:

Private Sub Command7_Click()
Dim strTable As String
Dim blnHasFieldNames As Boolean

blnHasFieldNames = True

Dim csv As String

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
'Allow user to make multiple selections in dialog box.
.AllowMultiSelect = True

'Set the title of the dialog box.
.Title = "Please select a Folder to Save backups"

.Show

End With



Set db = Application.CurrentDb

For Each i In db.TableDefs


If InStr(1, i.Name, "MSys") Then

GoTo Lp

End If

If InStr(1, i.Name, "Switch") Then

GoTo Lp

End If


If InStr(1, i.Name, "My Company") Then

GoTo Lp

End If

strTable = i.Name
Label8.Visible = True
Label8.Caption = "Backing up " & strTable & "..."

intfile = FreeFile()

csv = "c:\" & strTable & ".xml"
csv = fDialog.InitialFileName & strTable & ".xml"

Open csv For Output As intfile

Write #intfile,


Close intfile


Lp:

Next

'Label8.Caption = "Back up complete."
Label8.Visible = False

MsgBox "Backup complete"



End Sub

Private Sub Command9_Click()
Dim strTable As String
Dim blnHasFieldNames As Boolean

blnHasFieldNames = True

Dim csv As String

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
'Allow user to make multiple selections in dialog box.
.AllowMultiSelect = True

'Set the title of the dialog box.
.Title = "Please select a Folder that contains recent backups"


End With
Set db = Application.CurrentDb



For Each tdfcurrent In db.TableDefs



If tdfcurrent.RecordCount > 0 Then

If InStr(1, tdfcurrent.Name, "MSys") Then
ElseIf InStr(1, tdfcurrent.Name, "My Company") Then
ElseIf InStr(1, tdfcurrent.Name, "Switch") Then

Else
MsgBox ("Existing Data found in Database, aborted import")
Exit Sub
End If




End If


Next



For Each i In db.TableDefs


If InStr(1, i.Name, "MSys") Then

GoTo Lp

End If

If InStr(1, i.Name, "Switch") Then

GoTo Lp

End If


If InStr(1, i.Name, "My Company") Then

GoTo Lp

End If


If InStr(1, i.Name, "Order Details") Then

GoTo Lp

End If




strTable = i.Name
Label8.Visible = True
Label8.Caption = "Backing up " & strTable & "..."

intfile = FreeFile()

csv = fDialog.InitialFileName & strTable & ".xml"


Application.ImportXML csv, acAppendData

Lp:

Next
strTable = "Order Details"

'Label8.Caption = "Back up complete."
Label8.Visible = False

Label8.Caption = "Backing up " & strTable & "..."

intfile = FreeFile()

csv = fDialog.InitialFileName & strTable & ".xml"


DoCmd.TransferText acImportDelim, "" & strTable & " Export",
strTable, csv


MsgBox "Restore complete"


End Sub
 
F

Fox

Just in case anyone is interested and wants to create a backup and restore
for a packaged database that uses some attachment fields to include pictures
here is the code: This code is behind two buttons one to backup data in most
tables and one to restore those tables.

Private Sub Command7_Click()
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True

Dim csv As String

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
'Allow user to make multiple selections in dialog box.
.AllowMultiSelect = True

'Set the title of the dialog box.
.Title = "Please select a Folder to Save backups"

.Show

End With



Set db = Application.CurrentDb

For Each i In db.TableDefs


If InStr(1, i.Name, "MSys") Then

GoTo Lp

End If

If InStr(1, i.Name, "Switch") Then

GoTo Lp

End If


If InStr(1, i.Name, "My Company") Then

GoTo Lp

End If

' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
'strPath = "C:\Documents\"

' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = i.Name
Label8.Visible = True
Label8.Caption = "Backing up " & strTable & "..."

intfile = FreeFile()

csv = fDialog.InitialFileName & strTable & ".xml"

xsd = fDialog.InitialFileName & strTable & ".xsd"

xsl = fDialog.InitialFileName & strTable & ".xsl"

Open csv For Output As intfile

Write #intfile,


Close intfile


Application.ExportXML ObjectType:=acExportTable, DataSource:=strTable,
DataTarget:=csv, SchemaTarget:=xsd, PresentationTarget:=xsl


Lp:

Next

Label8.Visible = False

MsgBox "Backup complete"



End Sub

Private Sub Command9_Click()
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True

Dim csv As String

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
'Allow user to make multiple selections in dialog box.
.AllowMultiSelect = True

'Set the title of the dialog box.
.Title = "Please select a Folder that contains recent backups"


.Show

End With
Set db = Application.CurrentDb



For Each tdfcurrent In db.TableDefs



If tdfcurrent.RecordCount > 0 Then

If InStr(1, tdfcurrent.Name, "MSys") Then
ElseIf InStr(1, tdfcurrent.Name, "My Company") Then
ElseIf InStr(1, tdfcurrent.Name, "Switch") Then

Else
MsgBox ("Existing Data found in Database, aborted import")
Exit Sub
End If




End If


Next



For Each i In db.TableDefs


If InStr(1, i.Name, "MSys") Then

GoTo Lp

End If

If InStr(1, i.Name, "Switch") Then

GoTo Lp

End If


If InStr(1, i.Name, "My Company") Then

GoTo Lp

End If


If InStr(1, i.Name, "Order Details") Then

GoTo Lp

End If



' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
'strPath = "C:\Documents\"

' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = i.Name
Label8.Visible = True
Label8.Caption = "Backing up " & strTable & "..."

intfile = FreeFile()

csv = fDialog.InitialFileName & strTable & ".xml"


Application.ImportXML csv, acAppendData

Lp:

Next
strTable = "Order Details"


Label8.Visible = False

Label8.Caption = "Backing up " & strTable & "..."

intfile = FreeFile()

csv = fDialog.InitialFileName & strTable & ".xml"


Application.ImportXML csv, acAppendData

MsgBox "Restore complete"


End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

update db, no errors , no changes 6
VBA userform Vlookup Excel 1
Help - onclick sub never runs 4
PLEASE HELP, insert 1
Import multiple csv and add filename in additional field 4
Numeric Value Overflow - HELP??? 1
Convert to PDF 7
insert problems 1

Top