Access SQL: Export data from one database to another database if database/s are password protected using SQL

In some situation we need to transfer data form one database table to different database table. Now the question is can we do it with the help of access SQL query if we are already connected to one database. Here i am demonstrating how we can do it with SQL query in Access:

For Example:

First Database:-

       Name:- C:\TempDatabase_1.mdb

       Table Name:- TempTable_1

       Password:- DBPASS_1

Second Database:-

       Name:- C:\TempDatabase_2.mdb

       Table Name:- TempTable_2

       Password:- DBPASS_2

Now we want to get data form Second Database to First Database in the respective table. Here is the SQL:

SQL:

SELECT * INTO [TempTable_1] FROM [MS Access;Pwd=DBPASS_2;Database=C:\TempDatabase_2.mdb].[TempTable_2]

Create access database on the fly using DAO

Some time we need to use MS Access database to manipualte and store data quickly and for that we have to create it first but what if we want to create it on the fly.
There is a very common method ADOX catalog but some time it raises Class not register error  because of office version or OS version.

Here i am going to tell you an another method which is called DAO method.

Below is the procedure and function:

 

This is the main function

Option Explicit

Enum DBVersion
  dbVersion10 = 1
  dbVersion11 = 8
  dbVersion20 = 16
  dbVersion30 = 32
  dbVersion40 = 64 'Access2000 database
End Enum

Sub CreateDatabaseUsingDAO(ByVal FileName As String, ByVal DatabaseFormat As DBVersion)
'Author: Lalit Mohan
'Puropose: To create database on the fly using DAO

 Dim dbEng As Object
 Dim lngLong As Long
 Dim strObj As String
 
'Going through loop to create object (late binding)
 For lngLong = 0 To 50
 strObj = "DAO.DBEngine." & lngLong
 If lngLong = 0 Then strObj = "DAO.DBEngine"
 Set dbEng = Nothing
 On Error Resume Next
 Set dbEng = CreateObject(strObj)
 On Error GoTo -1: On Error GoTo 0: Err.Clear
 If Not dbEng Is Nothing Then Exit For
 Next lngLong
 
 'If DAO object is created then create database on the fly
 If Not dbEng Is Nothing Then
 dbEng.CreateDatabase FileName, ";LANGID=0x0409;CP=1252;COUNTRY=0", DatabaseFormat
 End If
 
 'Releasing Memory
 Set dbEng = Nothing
 lngLong = Empty
 strObj = vbNullString

End Sub

Sub test()

 'Here is how you can use it
 Call CreateDatabaseUsingDAO("Full path name here", dbVersion40)

End Sub

Copy/Paste Excel Range/Chart into Powerpoint VBA

Here is a function which will export excel range, chart, shape or print area to Power point

Add new module and copy below code

Option Explicit 

Public Enum PasteFormat
    xl_Link = 0
    xl_HTML = 1
    xl_Bitmap = 2
End Enum 
 
Sub Copy_Paste_to_PowerPoint(ByRef ppApp As Object, ByRef ppSlide As Object, ByRef PasteObject As Object, Optional ByVal Paste_Type As PasteFormat)
    
    Dim PasteRange      As Boolean
    Dim objChart        As ChartObject
    Dim lngSU           As Long
    
    Select Case TypeName(PasteObject)
        Case "Range"
            If Not TypeName(Selection) = "Range" Then Application.Goto PasteObject.Cells(1)
            PasteRange = True
        Case "Chart": Set objChart = PasteObject.Parent
        Case "ChartObject": Set objChart = PasteObject
        Case Else
            MsgBox PasteObject.Name & " is not a valid object to paste. Macro will exit", vbCritical
            Exit Sub
    End Select
    
    ppApp.ActiveWindow.View.GotoSlide ppSlide.slidenumber
    
    On Error GoTo -1: On Error GoTo 0
    DoEvents
    
    If PasteRange Then
        If Paste_Type = xl_Bitmap Then
            '//Paste Range as Picture
            PasteObject.CopyPicture Appearance:=1, Format:=-4147
            ppSlide.Shapes.Paste.Select
        ElseIf Paste_Type = xl_HTML Then
            '//Paste Range as HTML
            PasteObject.Copy
            ppSlide.Shapes.PasteSpecial(8, link:=1).Select  'ppPasteHTML
        ElseIf Paste_Type = xl_Link Then
            '//Paste Range as Linked
            PasteObject.Copy
            ppSlide.Shapes.PasteSpecial(0, link:=1).Select   'ppPasteDefault
        End If
    Else
        If Paste_Type = xl_Link Then
            '//Copy & Paste Chart Linked
            objChart.Chart.ChartArea.Copy
            ppSlide.Shapes.PasteSpecial(link:=True).Select
        Else
            '//Copy & Paste Chart Not Linked
            objChart.Chart.CopyPicture Appearance:=1, Size:=1, Format:=2
            ppSlide.Shapes.Paste.Select
        End If
    End If
     
    '//Center pasted object in the slide
    With ppApp.ActiveWindow.Selection.ShapeRange
        .LockAspectRatio = False
        .Height = ppSlide.Parent.PageSetup.SlideHeight * 0.98
        .LockAspectRatio = False
        .Width = ppSlide.Parent.PageSetup.SlideWidth * 0.98
        .Align msoAlignCenters, True
        .Align msoAlignMiddles, True
    End With
    
    Call AppActivate("Microsoft Excel")
    
End Sub


'Here is how we can use it
Sub PrintAreaToPPT()    
    Dim ppApp       As Object
    Dim ppSlide     As Object
    
    Application.ScreenUpdating = False
    On Error Resume Next
    Set ppApp = GetObject(, "Powerpoint.Application")
    On Error GoTo -1: On Error GoTo 0: Err.Clear
    
    If ppApp Is Nothing Then
        Set ppApp = CreateObject("Powerpoint.Application")
        ppApp.Visible = True
        ppApp.presentations.Add
    End If
    
    If ppApp.ActivePresentation.Slides.Count = 0 Then
        Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, 12) 'ppLayoutBlank
    Else
        ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, 12
        Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)
    End If
    
    Call Copy_Paste_to_PowerPoint(ppApp, ppSlide, ActiveSheet.Range("Print_Area"), xl_Bitmap)
    
    Application.ScreenUpdating = True
    
    Set ppApp = Nothing
    Set ppSlide = Nothing
    
End Sub
 

Excel Shapes Placement Property set by VBA.

Sub ShapePlacement()
    With ActiveSheet.DrawingObjects
         If Not .Placement = xlFreeFloating Then .Placement = xlFreeFloating 'xlMove xlMoveAndSize
    End With
End Sub