Microsoft.ACE.OLEDB

Question

Microsoft.ACE.OLEDB

Anonymous

Hi,

Can any one tell me what is Microsoft.ACE.OLEDB for office 2013?

Thanks,

Krishana Singh

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

6 answers

Answer 1

I expect the mdd file is not in the correct format expected by the newer version of OLE DB Provider

Please post your question to the MSDN Forum where you will get a quicker and more informed answer from one of the developers there:

https://social.msdn.microsoft.com/Forums/en-us/home

or more specifically the MSDN VBA forum:

https://social.msdn.microsoft.com/Forums/en-US/home?forum=isvvba

Answer 2

In 2010 it is working but not in 2013:

This code is for extracting mdd file text and variable in excel:

On Error Goto ErrorHandler

Dim sourceMDD, mdmWrite, sourceXL

#if ! defined (SOURCE_MDD)

sourceMDD = fnGetFile("Please Enter Source MDD Full or Relative path")

If sourceMDD = Null Then Exit

#else

sourceMDD = fnGetAbsolutePath(SOURCE_MDD)

If sourceMDD = Null Then Err.Raise(404,,"Cannot find Source MDD")

#endif

#if ! defined (MDM_WRITE)

mdmWrite = IIf(Debug.MsgBox("Update MDD with Translations from Excel?", 4, "ExcelCustomProperties Utility") = 6, True, False)

#else

mdmWrite = IIf(MDM_WRITE = 1, True, False)

#endif

If mdmWrite Then

#if ! defined (SOURCE_XL)

sourceXL = fnGetFile("Please Enter Source Excel Full or Relative path")

#else

sourceXL = fnGetAbsolutePath(SOURCE_XL)

If sourceXL = Null Then Err.Raise(404,,"Cannot find Source Excel")

#endif

End If

#if ! defined (TRANSLATION_PROPERTY)

#define TRANSLATION_PROPERTY "translate"

#endif

#if ! defined (CONTEXT)

#define CONTEXT "Question"

#endif

#if ! defined (UPDATE_BASE)

#define UPDATE_BASE 0

#endif

#if ! defined (LANGUAGES)

#define LANGUAGES Null

#endif

Dim updateBaseLang

updateBaseLang = IIF(UPDATE_BASE = 1, True, False)

Dim translate

translate = true

Dim planguages

planguages = fnGetLanguages(Split(LANGUAGES, ","))

Dim fso, srcPath, projectName, xlFullPath, xlPath

Set fso = CreateObject("Scripting.FileSystemObject")

srcPath = fso.GetParentFolderName(fso.getAbsolutePathName(sourceMDD))

projectName = fso.GetBaseName(fso.getAbsolutePathName(sourceMDD))

Dim oMDM, oLanguages, oType, oField, oPage, lang, xlApp

Set oMDM = CreateObject("MDM.Document")

oMDM.Open(sourceMDD,,3 '!oNOSAVE!')

Set oLanguages = oMDM.Languages

oMDM.Contexts.Current = CONTEXT

If mdmWrite Then

xlFullPath = fnPrepareTranslationWorkBook(fso, srcPath, sourceXL, oMDM, planguages, updateBaseLang)

If xlFullPath = False Then

Err.Raise(405, , "Excel WorkBook Invalid")

End If

Else

xlFullPath = fnTranslationWorkBook(fso, srcPath, projectName, oLanguages, planguages)

End if

Dim ConnectionString, ado, rs

ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" +xlFullPath+ ";Extended Properties=""Excel 8.0;HDR=Yes;TypeGuessRows=0"";"

Set ado = CreateObject("ADODB.Connection")

ado.Open(ConnectionString)

For Each oType in oMDM.Types

translate = true

if NOT isEmpty(oType.Properties.Item[TRANSLATION_PROPERTY][oMDM.Document.Contexts.Current]) then translate = oType.Properties.Item[TRANSLATION_PROPERTY][oMDM.Document.Contexts.Current]

sbProcessElements(ado, oType, translate, TRANSLATION_PROPERTY, mdmWrite)

For Each oField in oMDM.Fields

If oField.isSystem = False Then

sbProcessField(ado, oField, translate, TRANSLATION_PROPERTY, mdmWrite)

End If

sbProcessField(ado, oPage, translate, TRANSLATION_PROPERTY, mdmWrite)

oMDM.Save(fnSaveAsName(fso, srcPath, "Translated_"+projectName, "mdd"))

End If

ErrorHandler:

If Err.Number = -2146824582 Then

Debug.Log("Error. Description: The Microsoft.ACE.OLEDB.12.0 Provider cannot be found. It may not be properly installed. See https://www.microsoft.com/en-au/download/details.aspx?id=13255")

ElseIf Err.Number <> 0 Then

Debug.Log(Replace(makeString("Error. Description: ", Err.Description, " : Line : " , Err.LineNumber),mr.CrLf, " "))

End if

' Close ado

If NOT isNullObject(ado) Then

If ado.State <> 0 Then ado.Close()

End If

If NOT isNullObject(fso) Then

If mdmWrite AND fso.FileExists(xlFullPath) Then

fso.DeleteFile(xlFullPath,True)

End If

If Err.Number = 0 Then Debug.Log("Complete")

'------------------------------------------------------------------------------------------------------------

'--------------------------------------------- Functions & Subs ---------------------------------------------

'------------------------------------------------------------------------------------------------------------

Sub sbProcessField(ado, oField, translate ,tProp, mdmWrite)

Dim sField

If NOT isEmpty(oField.Properties.Item[tProp][oField.Document.Contexts.Current]) Then translate = oField.Properties.Item[tProp][oField.Document.Contexts.Current]

If translate Then

If mdmWrite Then

sbMdmTranslations(ado, oField)

Else

sbXlsTranslations(ado, oField)

End If

If IsOneOf(oField.ObjectTypeValue, 1 '!mtArray!', 2 '!mtGrid!', 3 '!mtClass!', 18 '!mtCompound!') Then

For Each sField in oField.Fields

sbProcessField(ado, sField, translate, tProp, mdmWrite)

If NOT IsOneOf(oField.ObjectTypeValue, 3 '!mtClass!', 38 '!mtPage!') Then

If oField.Elements.Count > 0 Then

sbProcessElements(ado, oField.Elements, translate, tProp, mdmWrite)

End If

If oField.ObjectTypeValue <> 38 '!mtPage!' Then

If oField.HelperFields.Count > 0 Then

For Each sField in oField.HelperFields

sbProcessField(ado, sField, translate, tProp, mdmWrite)

End If

End Sub

Sub sbProcessElements(ado, oElement, translate, tProp, mdmWrite)

Dim i, sElement

If NOT isEmpty(oElement.Properties.Item[tProp][oElement.Document.Contexts.Current]) Then translate = oElement.Properties.Item[tProp][oElement.Document.Contexts.Current]

If oElement.ObjectTypeValue = 4 '!mtElement!' OR (oElement.ObjectTypeValue = 5 '!mtElements!' AND oElement.FullName <> Null) AND oElement.IsReference = False Then

If translate Then

If mdmWrite Then

sbMdmTranslations(ado, oElement)

Else

sbXlsTranslations(ado, oElement)

End If

If oElement.ObjectTypeValue = 5 '!mtElements!' AND oElement.IsReference = False Then

For Each sElement In oElement

sbProcessElements(ado, sElement, translate, tProp, mdmWrite)

End Sub

Function fnxlFirstSheet(ado)

Dim tables

Set tables = ado.OpenSchema(20 '!adSchemaTables!')

tables.MoveFirst()

fnxlFirstSheet = tables.Fields["TABLE_NAME"].Value

End Function

Sub sbXlsTranslations(ado, mdmObj)

Dim ColumnsSchema, array[], insertStr

array[2] = fnxlFirstSheet(ado)

ado.Execute(makestring("INSERT INTO [", array[2], "] ([Question],[Type]) VALUES (", _

"'", fnMdmFullName(mdmObj), "',", _

"'", fnMdmType(mdmObj),"')"))

Set ColumnsSchema = ado.OpenSchema(4 '!adSchemaColumns!', array)

ColumnsSchema.MoveFirst()

Do While Not ColumnsSchema.EOF

If ColumnsSchema.Fields["COLUMN_NAME"].Value <> "Question" AND ColumnsSchema.Fields["COLUMN_NAME"].Value <> "Type" Then

insertStr = fnEscapeString(mdmObj.Labels["Label"].Text[mdmObj.Document.Contexts.Current][left(ColumnsSchema.Fields["COLUMN_NAME"].Value,Find(ColumnsSchema.Fields["COLUMN_NAME"].Value,":"))])

ado.Execute(makeString("UPDATE [", array[2], "] SET [", ColumnsSchema.Fields["COLUMN_NAME"].Value, "]=""", insertStr, """ WHERE [Question] = '", fnMdmFullName(mdmObj), "' AND [Type] = '", fnMdmType(mdmObj), "'"))

End If

ColumnsSchema.MoveNext()

Loop

End Sub

Sub sbMdmTranslations(ado, mdmObj)

Dim rs, field

Set rs = ado.Execute(makeString("SELECT * FROM [", fnxlFirstSheet(ado), "] WHERE ", _

"[Question] = '", fnMdmFullName(mdmObj), "'", _

" AND [Type] = '", fnMdmType(mdmObj), "'"))

If NOT (rs.EOF or rs.BOF) Then

rs.MoveFirst()

For Each field In rs.Fields

if field.Name <> "Question" AND field.Name <> "Type" Then

If NOT field.Value.isEmpty() Then

mdmObj.Labels["Label"].Text[mdmObj.Document.Contexts.Current][field.Name] = field.Value

Else

mdmObj.Labels["Label"].Clear(mdmObj.Document.Contexts.Current, field.Name)

End If

If NOT (rs.BOF OR rs.EOF) Then

Debug.Log(makeString("More then 1 Row for Translation : ", fnMdmFullName(mdmObj), " : ", fnMdmType(mdmObj)))

End If

End Sub

Function fnTranslationWorkBook(fso, path, projectName, oLanguages, pLanguages)

Dim xlApp, xlWorkbook, xlSheet, lang, i

Set xlApp = CreateObject("Excel.Application")

xlApp.ScreenUpdating = False

Set xlWorkbook = xlApp.Workbooks.Add()

Set xlSheet = xlWorkbook.Sheets[1]

With xlSheet

.Cells.NumberFormat = "@"

.Cells[1][1].Value = "Question"

.Cells[1][2].Value = "Type"

.Cells[1][3].Value = makeString(oLanguages.Base, ":", oLanguages[oLanguages.Base].LongName)

.Cells[2][3].Value = " "

For i = 1 To 8

.Cells[2][3].Value = makeString(.Cells[2][3].Value, .Cells[2][3].Value) ' Ensure 255+ Chars Allowed

if lang.Name <> oLanguages.Base Then

If (Find(pLanguages, lang.Name) > -1) OR pLanguages = Null Then

.Cells[1][.Cells.SpecialCells(11 '!xlCellTypeLastCell!').Column + 1].Value = makeString(lang.Name, ":", lang.LongName)

.Cells[2][.Cells.SpecialCells(11 '!xlCellTypeLastCell!').Column].Value = " "

For i = 1 To 8

.Cells[2][.Cells.SpecialCells(11 '!xlCellTypeLastCell!').Column].Value = makeString(.Cells[2][.Cells.SpecialCells(11 '!xlCellTypeLastCell!').Column].Value, .Cells[2][.Cells.SpecialCells(11 '!xlCellTypeLastCell!').Column].Value) ' Ensure 255+ Chars Allowed

End If

.Rows[2].Hidden = True

.Cells.WrapText = False

End With

fnTranslationWorkBook = fnSaveAsName(fso, path, "Translation_"+projectName, "xlsx")

xlWorkbook.SaveAs(fnTranslationWorkBook)

xlWorkBook.Close()

xlApp.Quit()

End Function

Function fnPrepareTranslationWorkBook(fso, path, xlPath, oMDM, pLanguages, updateBaseLang)

Dim xlApp, xlWorkbook, xlSheet, lang, i, iCol

Set xlApp = CreateObject("Excel.Application")

Set xlWorkbook = xlApp.Workbooks.Open(xlPath)

Set xlSheet = xlWorkbook.Sheets[1]

With xlSheet

On Error Resume Next

If .Cells[1][1].Value <> "Question" Then

Err.Raise(999,,"Invalid Traslation WorkBook: Column A Must be labeled 'Question'")

End If

If .Cells[1][2].Value <> "Type" Then

Err.Raise(998,,"Invalid Traslation WorkBook: Column A Must be labeled 'Type'")

End If

On Error Goto Error_Handler

.Cells.NumberFormat = "@"

If .Cells.SpecialCells(11 '!xlCellTypeLastCell!').Column > 2 Then

For iCol = .Cells.SpecialCells(11 '!xlCellTypeLastCell!').Column To 3 Step -1

lang = IIF(fnLanguageName(left(.Cells[1][iCol].Value,Find(.Cells[1][iCol].Value,":"))) <> Null, _

fnLanguageName(left(.Cells[1][iCol].Value,Find(.Cells[1][iCol].Value,":"))), _

fnLanguageName(.Cells[1][iCol].Value))

if lang = Null Then

Debug.Log(makeString("Invalid Language : ",.Cells[1][iCol].Value))

.Columns[iCol].Delete()

ElseIf NOT ((Find(pLanguages, lang) > -1) OR pLanguages = Null) OR (updateBaseLang = False AND lang = oMDM.Languages.Base) Then

Debug.Log(makeString("Language Ignored : ",.Cells[1][iCol].Value))

.Columns[iCol].Delete()

Else

If fnAddLanguage(oMDM.Languages, lang) Then

.Cells[1][iCol].Value = lang

If .Cells[2][1].Value <> "" Then

.Rows[2].Insert()

End if

.Cells[2][iCol].Value = " "

For i = 1 To 8

.Cells[2][iCol].Value = makeString(.Cells[2][iCol].Value, .Cells[2][iCol].Value) ' Ensure 255+ Chars Allowed

.Columns[iCol].Delete()

End If

End if

End With

fnPrepareTranslationWorkBook = fnSaveAsName(fso, path, "TempTranslation", "xlsx")

xlWorkbook.SaveAs(fnPrepareTranslationWorkBook)

Error_Handler:

If Err.Number <> 0 Then

Debug.Log(makeString("Error. Description: ", Err.Description, " : Line : " , Err.LineNumber))

fnPrepareTranslationWorkBook = False

End If

xlWorkBook.Close(False)

xlApp.Quit()

End Function

Function fnMdmFullName(mdmObj)

If isOneOf(mdmObj.ObjectTypeValue, 4, 5) Then

fnMdmFullName = makeString(mdmObj.OwnerField.FullName, "^", mdmObj.FullName)

Else

fnMdmFullName = mdmObj.FullName

End If

End Function

Function fnMdmType(mdmObj)

If isOneOf(mdmObj.ObjectTypeValue, 4, 5) Then

fnMdmType = "Element"

Else

fnMdmType = "Question"

End If

End Function

Function fnLanguageName(langName)

Dim languageDefinitions

Set languageDefinitions = CreateObject("MDM.LanguageDefinitions")

If languageDefinitions.IsValid[langName] Then

fnLanguageName = languageDefinitions.Item[langName]

End If

End Function

Function fnAddLanguage(languages, langName)

Dim lang

fnAddLanguage = False

On Error Resume Next

lang = Languages.Item[langName]

if Err.Number <> 0 Then

Err.Clear()

languages.Add(langName)

if Err.Number = 0 Then

Debug.Log(makeString("Language Added : ", langName))

fnAddLanguage = True

End If

Else

fnAddLanguage = True

End If

End Function

Function fnGetLanguages(arrLanguages)

Dim i, lang[]

For i = 0 To UBound(arrLanguages)

if fnLanguageName(arrLanguages[i]) <> Null Then

lang[i] = fnLanguageName(arrLanguages[i])

End If

End Function

Function fnSaveAsName(fso, path, fileName, extension)

Dim i

Do

If NOT fso.FileExists(makeString(path, "", fileName, IIF(i = Null, "", makeString("_", i)), ".", extension)) Then

fnSaveAsName = makeString(path, "", fileName, IIF(i = Null, "", makeString("_", i)), ".", extension)

End If

i = i + 1

Loop Until fnSaveAsName <> Null

End Function

Function fnEscapeString(str)

Dim regEx

Set regEx = CreateObject("VBScript.RegExp")

With regEx

.Pattern = ChrW(34)

.Global = true

.IgnoreCase = true

.Multiline = false

fnEscapeString = .replace(str, ChrW(34)+ChrW(34))

End With

End Function

Function fnGetFile(label)

Dim fso, dialogLabel

Set fso = CreateObject("Scripting.FileSystemObject")

dialogLabel = label

Do

fnGetFile = InputBox(dialogLabel, "", "ExcelCustomProperties Utility")

dialoglabel = makeString(dialogLabel, mr.CrLf, mr.CrLf, "Cannot find mdd File : ", fnGetFile)

Loop Until fso.FileExists(fso.getAbsolutePathName(fnGetFile)) OR fnGetFile = Null

If fnGetFile <> Null Then fnGetFile = fso.getAbsolutePathName(fnGetFile)

End Function

Function fnGetAbsolutePath(path)

Dim fso

Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FileExists(fso.getAbsolutePathName(path)) Then

fnGetAbsolutePath = fso.getAbsolutePathName(path)

Else

fnGetAbsolutePath = Null

End If

End Function

Answer 3

Are you getting an error on your screen, if so please provide the text in the error and the heading on the error and I will try to advise . . .

If the error you are getting is: the 'microsoft.ace.oledb.12.0' provider is not registered on the local machine' you should find a fix on this page

https://social.msdn.microsoft.com/Forums/en-US/1d5c04c7-157f-4955-a14b-41d912d50a64/how-to-fix-error-the-microsoftaceoledb120-provider-is-not-registered-on-the-local-machine?forum=vstsdb

Answer 4

Anonymous

Thanks, and what is excel version for 2013?

0 comments

Answer 5

DaveM121 890.1K Independent Advisor

This OLE DB Provider is provided by Microsoft and is contained in the file ACEOLEDB.DLL. The Microsoft ACE OLEDB 12.0 provider can be used to connect to many data sources like MS Access, Foxpro, Excel, Sharepoint Etc.

0 comments

Share via

Microsoft.ACE.OLEDB

6 answers