I'm having issues converting an old access mdb to the newer format (2007) accdb.
In the past I have used the following code, that works:
' Delete the resultant accdb just in case
File.Delete("C:\temp\TheTargetDB.accdb")
Dim oAccess = CreateObject("Access.Application")
Dim ret = oAccess.SysCmd(603, "C:\temp\TheSourceDB.mdb", "C:\temp\TheTargetDB.accdb")
oAccess.quit()
oAccess = Nothing
If ret = 0 Then
MsgBox("DID NOT CONVERT")
Exit Sub
End If
However, I've tried using it with variables and this doesn't work:
Dim SourceDBName As String = "C:\temp\TheSourceDB.mdb"
Dim TargetDBName As String = "C:\temp\TheTargetDB.accdb"
' Delete the resultant accdb just in case
File.Delete(TargetDBName)
Dim oAccess = CreateObject("Access.Application")
Dim ret = oAccess.SysCmd(603, SourceDBName, TargetDBName)
oAccess.quit()
oAccess = Nothing
If ret = 0 Then
MsgBox("DID NOT CONVERT")
Exit Sub
End If
Is there anything special about the SysCmd that I'm not aware of?
After many hours of pulling my hair out, I stumbled onto the answer while reviewing the Microsoft Doc article: MS Access SysCmd method
The argument types for the source and target are the old 'variant' data type.
I decided to modify my code to cast the string variables to the 'Object' type:
Dim ret = oAccess.SysCmd(603, CObj(SourceDBName), CObj(TargetDBName))
vs2019 says the cast is redundant, but guess what? - it worked!
I hope this is useful to anyone in a similar situation.
Cheers
Andrew
Related
I want to access a Lotus Notes Database and get attachments from documents in it.
I can open the DB and doc and loop through all items.
The problem is, I can not use the items as NotesRichTextItem and therefore not check if there are any item.EmbeddedObject.
I guess it is a problem with declaration of the items.
In general: If I debug using VS2010, doc and the database and NotesSession have the "value" System.__ComObject and "type" is the Domino.Notes Object it should be.
e.g. doc in WATCH:
Name VALUE TYPE
doc {System.__ComObject} Domino.NotesDocument
but if I use the doc.GetType() command the result is
doc.GetType() = {Name = "__ComObject" FullName = "System.__ComObject"}
Since I do not know if my doc.item is a NotesRichTextItem, I define it as an object and want to check afterwards is type. Which I can't since the return value of the functions is as above for doc, too.
Here is the complete code I use currently, I loaded the Lotus Domino reference from the COM section.
Public Sub OpenDocumentLN()
Try
Dim ns As New Domino.NotesSession
Dim db As Domino.NotesDatabase
Dim doc As Domino.NotesDocument
Dim view As Domino.NotesView
If Not (ns Is Nothing) Then
ns.Initialize()
db = ns.GetDatabase("", sLotusNotesPath & sLotusNotesDB, False)
If Not (db Is Nothing) Then
view = db.GetView(sLotusView)
doc = view.GetFirstDocument
While Not doc Is Nothing
Dim lnNextDoc As Domino.NotesDocument = view.GetNextDocument(doc)
For Each item As Domino.NotesItem In doc.Items
Dim rtItem As Object = doc.GetFirstItem(item.Name)
If rtItem Is Nothing Then Continue For
If Not rtItem.GetType() = GetType(Domino.NotesRichTextItem) Then Continue For
' NEVER reach this part of the code since the IF clause prevents it due to the type problem
If rtItem.EmbeddedObjects Is Nothing Then Continue For
For Each o As Domino.NotesEmbeddedObject In rtItem.EmbeddedObjects
o.ExtractFile(sLotusExportPath & o.Source)
Next
Next
doc = lnNextDoc
End While
End If
db = Nothing
ns = Nothing
End If
Catch ex As Exception
End Try
End Sub
How can I use my rtitem as a NotesRichTextItem so I can handle it appropiate? And why are all objects are treated als ComObjects?
I have a vb.net code and want to convert it in vb 6.0. But I have some difficulties. I cant find equivalent of some .net classes
Dim byteswritten As Integer
Dim fs As System.IO.FileStream
Dim r As System.IO.BinaryReader
Dim CHUNK_SIZE As Integer = 65554
fs = New System.IO.FileStream(filePath, System.IO.FileMode.Open, System.IO.FileAccess.Read)
r = New System.IO.BinaryReader(fs)
Dim FSize As Integer = CType(fs.Length, Integer)
Dim chunk() As Byte = r.ReadBytes(CHUNK_SIZE)
While (chunk.Length > 0)
dmPutStream.Write(chunk, chunk.Length, byteswritten)
If (FSize < CHUNK_SIZE) Then
CHUNK_SIZE = FSize
chunk = r.ReadBytes(CHUNK_SIZE)
Else
chunk = r.ReadBytes(CHUNK_SIZE)
End If
End While
Well, the document can be big then we used chunk. But I dont know steps for vb 6.0
Such as what i should do for binary reading.
Without all your code for opening the write stream and closing the read and write streams, here's an example of how you can do it in VB6 using ADODB.Stream.
Under Project | References, add a reference to ADO Active X Data Objects Library. My version is 6.1, but you should be okay to just choose the latest version - depends on what version of ADO is installed on your system
Hope it helps - more info online if you want to look at all the ADODB.Stream methods and properties
Public Sub StreamData(strWriteFilename As String, filePath As String)
Const CHUNK_SIZE As Long = 65554
Dim byteswritten As Integer
Dim FSize As Long
Dim adofs As New ADODB.Stream 'Object 'System.IO.FileStream
Dim varData As Variant
' Include this here - but probably defined elsewhere
Dim dmPutStream As New ADODB.Stream
' Open Write Stream
' *** Looks like you do this elsewhere
Set dmPutStream = CreateObject("ADODB.Stream")
With dmPutStream
.Type = adTypeBinary
.Open strWriteFilename, adModeWrite
End With
' Open Read strema and start pushing data from it to the write stream
Set adofs = CreateObject("ADODB.Stream") 'New System.IO.FileStream(filePath, System.IO.FileMode.Open, System.IO.FileAccess.Read)
With adofs
.Type = adTypeBinary
.Open
.LoadFromFile filePath
' Size of Read file - do you want this?
FSize = .Size
varData = .Read(CHUNK_SIZE)
Do While Len(varData) > 0
dmPutStream.Write varData
If Not .EOS Then
varData = .Read(CHUNK_SIZE)
End If
Loop
.Close
End With
'Save binary data To disk
dmPutStream.SaveToFile strWriteFilename, adSaveCreateOverWrite
dmPutStream.Close
End Sub
Converting VB.NET to VB6 is a bad idea, and completely unnecessary. If you need to use the VB.NET code from a VB6 application, the best thing to do would be to create a COM-visible wrapper for your .NET library, and call that wrapper from your VB6 application.
You probably CAN convert the code functionally with VB6, but there really is no point. VB.NET is a better language than VB6, use its COM capabilities to save you from writing endless sketchy VB6 code.
If you are dead set on doing this, you will need to reproduce the Stream and Reader classes functionally.
Here is the source for FileStream.cs:
http://referencesource.microsoft.com/#mscorlib/system/io/filestream.cs
And for BinaryReader:
http://referencesource.microsoft.com/#mscorlib/system/io/binaryreader.cs
I have an Access database divided into front and back ends.
I need to modify the value of a property associated to one of the fields in a table programmatically. I do remember achieving something similar years ago, but that was for forms.
It seems that the properties of a table can only be set at design time; any attempt to modify the values using code (myField.Properties("InputMask").Value = "000000") causes an error.
All in all, there are about 40 or 50 tables in a batch of roughly 80 that have a particular type of field that has to be changed, so I'd rather do this using code than manually. Could anyone suggest a method for doing this using VBA, please?
Presently I've looked at dropping and recreating the field using CurrentDb.Execute sqlString, but I'd like to retain the InputMask property if at all possible.
The original database is a 2002/3 format, but I'm editing this in Access 2010.
I got the following code to work. It will change the InputMask of the specified Table and Field....
Option Compare Database
Option Explicit
Sub Test_It()
Dim WGD
WGD = Resize_And_AddInputMask("Table3", "SomeNbr")
End Sub
' Modified version of code found at: http://www.tek-tips.com/viewthread.cfm?qid=1708626
Public Function Resize_And_AddInputMask(ByVal someTableName As String, ByVal someZCField As String)
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim fd As DAO.Field
Dim prp As DAO.Property
Set db = CurrentDb
Set td = db.TableDefs(someTableName)
Set fd = td.Fields(someZCField)
fd.Properties("InputMask") = "000099"
fd.Properties.Refresh
db.TableDefs.Refresh
Set prp = Nothing
Set fd = Nothing
Set td = Nothing
Set db = Nothing
End Function
Using EPPlus I read an XLSX file.
I replace the data in a table and set the table range.
When I open the resulting spreadsheet I get an error:
"We found a problem with some content in 'MySpreadsheet.xlsx'. Do you want us to try to recover as much as we can?" -- I click Yes and I get another error:
"Excel was able to open the file by repairing or removing the unreadable content. Removed Part: Data store"
The error only happens after I add this table to a PowerPivot data model.
[EDIT] - I created a win forms app that reproduces this problem. You
can download it at here
I found the problem but don't know how
to fix it.
rename the xlsx to zip
Open the zip and browse to the xl\workbook.xml file
Look for the node collection.
Notice how EPPlus changes the <definedNames> collection to use absolute cell addresses.
Excel: <definedName name="_xlcn.LinkedTable_MyDate" hidden="1">MyDate[]</definedName>
EPPlus: <definedName name="_xlcn.LinkedTable_MyDate" hidden="1">'MyDate'!$A$2:$A$5</definedName>
If I modify this line after EPPlus is done saving then I can pull it
up in Excel without corrupting the Data Model.
I tried changing the WorkbookXml but it is happening when the
ExcelPackage.Save method runs.
For Each node In pck.Workbook.WorkbookXml.GetElementsByTagName("definedNames")(0).ChildNodes
node.innerText = "MyDate[]"
Next
Any ideas?
Try this first: create a spreadsheet with one table in it. Name the worksheet and table "DateList". Save it and run the below code on it -- it will work.
Then do this: open the same spreadsheet and add the DateList table to a pivottable data model. Save it and run the below code on it -- it will fail.
Here's some code from my MVC Controller -- only the relevant bits:
Public Class ScorecardProgressReportDatesVM
Public Property WeekRange As Date
End Class
Public Function GetScorecardProgressReport(id As Integer) As ActionResult
Dim contentType As String = "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
Dim DateList As New List(Of ScorecardProgressReportDatesVM)
DateList.Add(New ScorecardProgressReportDatesVM With {.WeekRange = CDate("Jan 1, 2015")})
DateList.Add(New ScorecardProgressReportDatesVM With {.WeekRange = CDate("Jan 1, 2015")})
Dim templateFile As New IO.FileInfo("c:\test.xlsx")
Dim ms As New IO.MemoryStream
Using pck As New ExcelPackage(templateFile)
ExtendTable(pck, "DateList", DateList)
pck.SaveAs(ms)
ms.Position = 0
End Using
Dim fsr = New FileStreamResult(ms, contentType)
fsr.FileDownloadName = "StipProgress.xlsx"
Return fsr
End Function
Private Sub ExtendTable(package As ExcelPackage, tableName As String, newList As Object)
Dim ws As OfficeOpenXml.ExcelWorksheet
ws = package.Workbook.Worksheets(tableName)
Dim OutRange = ws.Cells("A1").LoadFromCollection(newList, True)
Dim t = ws.Tables(tableName)
Dim te = t.TableXml.DocumentElement
Dim newRange = String.Format("{0}:{1}", t.Address.Start.Address, OutRange.End.Address)
te.Attributes("ref").Value = newRange
te("autoFilter").Attributes("ref").Value = newRange
End Sub
In order to fix this we had to change the EPPlus v4.04 source code.
ExcelWorkbook.cs # line 975 was changed
//elem.InnerText = name.FullAddressAbsolute; This was causing issues with power pivot
to
elem.InnerText = name.FullAddress; //Changed to full address... so far everything is working
I have following code in an lotusscript agent that removes attachments from NotesDocuments. But NotesDocument.save() causes loss of rich text formatting (font, color). Is there any way to retain the formatting?
Sub removeAttachments_v2(doc As NotesDocument)
Dim session As NotesSession
Dim rtitem As Variant
Dim filename As String
Dim ans As Variant
Set session = New NotesSession
Dim richstyle As NotesRichTextStyle
Set richstyle = session.CreateRichTextStyle
richstyle.NotesColor = COLOR_BLUE
If doc.HasEmbedded Then
Set rtitem = doc.getfirstitem("Body")
If (rtitem.type = RICHTEXT) Then
ForAll object In rtitem.EmbeddedObjects
If (object.Type = EMBED_ATTACHMENT) Then
filename = object.source
Call object.remove
Call rtitem.AddNewLine( 2 )
Call rtitem.AppendStyle(richstyle)
Call rtitem.AppendText( "Attachemnt removed: " & filename )
Call doc.Save( True, True , True )
End If
End ForAll
End If
End If
End sub
Edit1: Initialize function
Sub Initialize
Dim db As New NotesDatabase("","")
Dim col As NotesDocumentCollection
Dim doc As NotesDocument
Call db.Open("", "C:\this\is\db\dir\test.nsf")
Set col = db.Alldocuments
Set doc = col.Getfirstdocument()
While Not ( doc Is Nothing )
Call RemoveAttachments_v2(doc)
Call doc.Save(False, False, False)
Set doc = col.GetNextDocument( doc )
Wend
End Sub
Despite of the fact, that you save the document for every attachment I cannot find any reason, why this should happen. I just copied your code in an agent, and it removes the attachments as desired and appends the text in blue...
No formatting is lost...
The error has to be somewhere else in your code, probably in the calling function.
OLD ANSWER (wrong due to own tests, just kept here as history):
The Problem here most probably is: you defined rtitem as Variant. And
getfirstitem gets you a NotesItem instead of a NotesRichtextItem, so
when saving, it is converted to a "plain Text" item.
Most probably you used Variant instead of NotesRichtextItem, because
there are Mime- mails where defining the variable as NotesRichtextItem
will cause an "Type Missmatch" or similar error. As long as you do not
write anything back this is OK.
As Mime Mails need complete different handling to achieve your goal,
you should first fix the code for pure NotesRichtextItems by using the
right type, and then write another code- branch for handling Mime-
items