Showing posts with label Access VBA. Show all posts

VBA to Upload Files to Access Database as Attachment

VBA to Upload Files to Access Database as Attachment - New Video

https://www.youtube.com/watch?v=NXttvEe4DSo

Option Compare Database
Option Explicit

Sub upload_file_from_excel_to_access_db()

Dim db As DAO.Database
Dim ws As DAO.Workspace

Dim rst As DAO.Recordset
Dim attachFld As DAO.Recordset

Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase("D:\VBAA2Z Demo\Access VBA\Attachment Load\org_db.accdb", False, False, "MS Access;PWD=")

Set rst = db.OpenRecordset("SELECT * FROM AttachmentDemotb;", dbOpenDynaset)

rst.AddNew
  
  rst!Title = "Test from Access-4"
  
  Set attachFld = rst.Fields("Attachements").Value
  
  attachFld.AddNew
    attachFld.Fields("FileData").LoadFromFile "D:\VBAA2Z Demo\Access VBA\Attachment Load\flows_report.pdf"
  attachFld.Update
  
  attachFld.AddNew
    attachFld.Fields("FileData").LoadFromFile "D:\VBAA2Z Demo\Access VBA\Attachment Load\plugandplay.JPG"
  attachFld.Update
  
  
rst.Update

rst.Close
db.Close
ws.Close

Set rst = Nothing
Set attachFld = Nothing
Set db = Nothing
Set ws = Nothing

End Sub

VBA - Dynamic file selection using File Dialogs and Import Data from selected Excel files

Hello friends,

Please find below the code used in the tutorial

VBA - Dynamic file selection using File Dialogs and Import Data from selected Excel files
If you have any questions please feel free to comment below the video or email me directly at vbaa2z.team@gmail.com and I will try and come back as soon as possible. Please do not forget to leave a like and subscribe to our channel. Thanks for your support.

Click here to Subscribe
Tutorial link: https://www.youtube.com/watch?v=eHuETf6ygto

Option Explicit
Public PriorCalcMode As Variant


'https://docs.microsoft.com/en-us/office/vba/api/office.filedialog
'https://docs.microsoft.com/en-us/office/vba/api/excel.application.filedialog

'MsoFileDialogType can be one of these constants:
'msoFileDialogFilePicker. Allows user to select a file.
'msoFileDialogFolderPicker. Allows user to select a folder.
'msoFileDialogOpen. Allows user to open a file.
'msoFileDialogSaveAs. Allows user to save a file.

Sub select_import_code()

'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on this code.
'Feel free to update the code as per your need and also share with your friends.
'Channel: Youtube.com/vbaa2z
'Download free codes from http://vbaa2z.blogspot.com
'Author: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

Dim vfd As Office.FileDialog
Dim vfd_file As Variant
Dim curFileName As String
Dim destination_wb As Workbook

Set vfd = Application.FileDialog(msoFileDialogFilePicker)

With vfd
    .AllowMultiSelect = True
    .InitialFileName = "D:\VBAA2Z Demo\FileDialog\ds files\"
    
    .Filters.Clear
    .Filters.Add "All Files", "*.xls*"
    .Show
    
    Debug.Print .SelectedItems.Count
    
    If .SelectedItems.Count <> 0 Then
    TurnOnSpeed True
    Set destination_wb = Workbooks.Add
    
    For Each vfd_file In .SelectedItems
       Debug.Print Trim(vfd_file)
       curFileName = vfd_file
       Debug.Print "Import status: " & get_data(curFileName, destination_wb)
    Next
    
    Else
    
    MsgBox "File not selected"
    
    End If
    
    
End With

destination_wb.SaveAs "D:\VBAA2Z Demo\FileDialog\ds files\masterWorkbook.xlsx", xlOpenXMLWorkbook

Set destination_wb = Nothing

TurnOnSpeed False
 
End Sub

Function get_data(wb_path$, xWb As Workbook) As Boolean

    Dim dslr As Long, new_lr As Long, paste_des_row As Long
    Dim copyrange As Range
    Dim tagRng As Range
    Dim headerCopiedCnt As Long
    
    Dim wb As Workbook
    Set wb = Workbooks.Open(wb_path, False, True)
    
    With wb
        dslr = .Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
        
        If headerCopiedCnt = 0 Then
          Set copyrange = .Sheets(2).Range("A1:K" & dslr)
          headerCopiedCnt = headerCopiedCnt + 1
          Else
          Set copyrange = .Sheets(2).Range("A2:K" & dslr)
        End If
        copyrange.Copy
    End With
    
    
    With xWb
        
        
        
        paste_des_row = .Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
        
        
        .Sheets(1).Range("B" & paste_des_row).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        
        new_lr = .Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
        
        Set tagRng = .Sheets(1).Range(Range(Cells(paste_des_row, 1), Cells(new_lr, 1)).Address)
        tagRng.Value = wb.Name
        Application.CutCopyMode = False
        Set tagRng = Nothing
        
    End With
    
    Set copyrange = Nothing
    wb.Close False
    Set wb = Nothing
    get_data = True
    
End Function




Public Function TurnOnSpeed(x As Boolean)
    If x = True Then
    With Application
        PriorCalcMode = Application.Calculation
            .ScreenUpdating = False
            .DisplayAlerts = False
            .EnableEvents = False
            .Cursor = xlWait
            .Calculation = xlCalculationManual
    End With
    
    ElseIf x = False Then
    
    With Application
            .ScreenUpdating = True
            .DisplayAlerts = True
            .EnableEvents = True
            .StatusBar = False
            .Cursor = xlDefault
        .Calculation = PriorCalcMode
        End With
    End If

End Function

VBA to load millions of records within seconds - new video

Like what I do? Donate

Did I help you? Did one of my tutorials save you sometime?

You can say thank you by buying me a cup of coffee, I go through a lot of it.

Help keep Greater Good resources free for everyone. Please donate today.

This page is not monitored so for questions please comment on the youtube video page. For suggestions email vbaa2z.team@gmail.com

Channel Link: https://www.youtube.com/vbaa2z
SharePoint Automation with VBA: https://www.youtube.com/watch?v=KdMM0hgp4q4&list=PLo0aMPtFIFDrcPiWbqJGb3qt3rkOmjDbN

Code

Option Explicit

'please visit for our channel for more tutorials -- > https://www.youtube.com/vbaa2z
'find connectionstring string for any db_ at -- > http://connectionstring.com/

Public Const Joinx$ = " IN '"

Public Function dbCon_Str() As String

'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on this code.
'Feel free to update the code as per your need and also share with your friends.
'Channel: Youtube.com/vbaa2z
'Download free codes from http://vbaa2z.blogspot.com
'Subscribe channel: youtube.com/vbaa2z
'Author: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

dbCon_Str = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath & _
"C:\My Documents\bulk_loader\finDB.accdb" & ";Jet OLEDB:Database Password=;"
End Function

Function xl_ext() As String
xl_ext$ = Joinx$ & ThisWorkbook.FullName & "' 'Excel 8.0;'"
End Function

Function connection_center(sql$) As Long
'youtube.com/vbaa2z
Dim aff_rc As Long, cn As ADODB.Connection

On Error GoTo err_hndler
Set cn = New ADODB.Connection

With cn
.Open dbCon_Str
.CursorLocation = adUseClient
.Execute (sql$), aff_rc
End With

connection_center = aff_rc

closeCon:

If CBool(cn.State And adStateOpen) = True Then cn.Close
Set cn = Nothing

Exit Function

err_hndler:
connection_center = False
Debug.Print Err.Description & Now()
GoTo closeCon

End Function

Sub bulk_upload()

'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on this code.
'Feel free to update the code as per your need and also share with your friends.
'Channel: Youtube.com/vbaa2z
'Download free codes from http://vbaa2z.blogspot.com
'Author: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

Dim mysql As String

Debug.Print Now()

mysql = "INSERT into DailyT SELECT * FROM [LoadSh$] " & xl_ext & "WHERE (((LoadSh$.T_type) = 'Inflow') AND ((LoadSh$.Amount) > 80000));"
Debug.Print connection_center(mysql)

End Sub

VBA to check if User has access to Network/Directory

VBA to check if User has access to Network/Directory.

Option Explicit

'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on how to use this code.
'Feel free to update the code as per your need and also share with your friends.
'Download free codes from http://vbaa2z.blogspot.com
'Support our channel: youtube.com/vbaa2z
'Author: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

Debug.Print FolderIsWriteable("D:\")

Function FolderIsWriteable(sFolder As String) As Boolean
    On Error Resume Next
    FolderIsWriteable = (GetAttr(sFolder) And vbReadOnly) <> 1
    Exit Function
End Function

How to Convert System time to any Time Zone using VBA

Hello friends, all relevant materials for this topic/tutorial can be downloaded from here. Please support us by subscribing to our channel and sharing them with your friends.

If you have any questions/feedback/tutorial request, please you can email me directly vbaa2z.team@gmail.com or comment on YouTube Video (blog comments are not actively monitored).

https://www.youtube.com/watch?v=kAe-uWJoaRw&lc

Option Compare Database
Option Explicit

Private Const TIME_ZONE_ID_STANDARD As Long = 1
Private Const TIME_ZONE_ID_DAYLIGHT& = 2
Dim dteStart As Date, dteFinish As Date
Dim dteStopped As Date, dteElapsed As Date
Dim boolStopPressed As Boolean, boolResetPressed As Boolean


Private Type SYSTEMTIME
    wyear As Integer
    wmonth As Integer
    wdayofweek As Integer
    whour As Integer
    wminute As Integer
    wsecond As Integer
    wmilliseconds As Integer
End Type

Private Type TIME_ZONE_INFORMATION
bias As Long
Standardname(1 To 63) As Byte
standarddate As SYSTEMTIME
standardbias As Long
Daylightname(0 To 63) As Byte
daylightdate As SYSTEMTIME
daylightbias As Long
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32" (IpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Public resetMe As Boolean
Public myVal As Variant


Public Function mytime() As String

'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on how to use this code.
'Feel free to update the code as per your need and also share with your friends.
'Download free codes from http://vbaa2z.blogspot.com
'Support our channel: youtube.com/vbaa2z
'Author: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

Dim tzi As TIME_ZONE_INFORMATION
Dim gmt As Date
Dim dwbias As Long
Dim tmp As String
Select Case GetTimeZoneInformation(tzi)
Case TIME_ZONE_ID_DAYLIGHT
dwbias = tzi.bias + tzi.daylightbias
Case Else
dwbias = tzi.bias + tzi.standardbias
End Select
gmt = DateAdd("n", dwbias, Now + TimeSerial(5, 30, 0))
tmp = Format$(gmt, "MM/DD/YYYY HH:MM:SS AM/PM")
mytime = tmp
End Function

VBA to Terminate Process

Below code example will Terminate firefox browser. To use this code to end other processes load your Windows task Manager and locate the process name and replace firefox.exe with your process name.

Option Explicit

Sub test_TerminateProcess()
    TerminateProcess ("firefox.exe")
End Sub
 
Function TerminateProcess(app_exe As String)

'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on this code.
'Feel free to update the code as per your need and also share with your friends.
'Channel: Youtube.com/vbaa2z
'Download free codes from http://vbaa2z.blogspot.com
'Autor: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

    Dim Process As Object
    For Each Process In GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process Where Name = '" & app_exe & "'")
        Process.Terminate
    Next
End Function

Connection Strings

Connection Strings

1. Excel to Access database Connection String


'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on this code.
'Feel free to update the code as per your need and also share with your friends.
'Channel: Youtube.com/vbaa2z
'Download free codes from http://vbaa2z.blogspot.com
'Autor: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

Public Const con1 As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\path\FinData2016.accdb;Jet OLEDB:Database Password=yourPassword;"

VBA ADO Access Db + Excel (YouTube)

Short video series will teach you how to integrate Excel and Access Database to create a business solution / automation. In detail and easy to follow tutorial you’ll learn how to use VBA to connect to tb, table, add, sync, update, delete records / data….have fun!

"Not a Valid Password - Runtime Error 3031" Excel ADO VBA Error Message even when password are correctly entered

Are you receiving "Not a Valid Password - Run-time Error 3031" Excel ADO VBA Error Message even when correct password are updated / passed in the argument?

You will encounter this error if you’ve have done MS office/Access upgrade from 2007 to 2010/2013/2016. Existing Code and databases should work.

If you’re creating new database and setting a password or changing the password of existing database using new office (MS ACCESS) you’ll face this issue when connecting via VBA ADO.

Follow below steps to troubleshoot this issue:

1. Fire up Access application (any access file)
2. Click on File and then Options
3. Click on Client Settings
4. Go to Advanced section and check "use legacy encryption (good for reverse compatibility and multi-user database)"
5. Restart Access (by closing all access database currently)
6. Set new password
7. Run your ADO Code to connect to database. It should be working now.

'-----------------------------
'Please visit our channel for a quick explainer on this code.
'Feel free to update the code as per your need and also share with your friends.
'Channel: Youtube.com/vbaa2z
'Download free codes from http://vbaa2z.blogspot.com
'Autor: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

VBA to list all file names in any Folder or Directory

You can use the below VBA code to list specified files types from Directory. Below demo sample code will list all .mp3 files in folder/directory "D:\Music\5 Seconds Of Summer\"

If you want to list other files type for example .xlsm files change "*.mp3" to "*.xlsm", or to list all files irrespective change it "*.mp3" to "*.*".

Please share or comment below if you have any questions.

Const vDir As String = "D:\Music\5 Seconds Of Summer\"
Const vPttrn As String = "*.mp3"
Dim vFile As String

Sub test_list_mp3_files()

'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on this code.
'Feel free to update the code as per your need and also share with your friends.
'Channel: Youtube.com/vbaa2z
'Download free codes from http://vbaa2z.blogspot.com
'Autor: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

vFile = Dir(vDir & vPttrn, vbNormal)

Do While Len(vFile) > 0
    Debug.Print vFile
    vFile = Dir
Loop

End Sub

for more please visit http://bit.ly/2dveQPZ

Youtube.com/VbaA2z (subscribe for new videos every weekend!)

Search