VBA Excel module for reading INI files.

Attribute VB_Name = "ReadINIFile"
Option Explicit

' Retrieves a string from the specified section in an initialization file.
' See here: https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-getprivateprofilestring?redirectedfrom=MSDN
' lpApplicationName     The name of the section containing the key name.
' lpKeyName             The name of the key whose associated string is to be retrieved.
' lpDefault             A default string.
' lpReturnedString      A pointer to the buffer that receives the retrieved string.
' nSize                 The size of the buffer pointed to by the lpReturnedString parameter, in characters.
' lpFileName            The name of the initialization file.

Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" ( _
    ByVal lpApplicationName As String, _
    ByVal lpKeyName As Any, _
    ByVal lpDefault As String, _
    ByVal lpReturnedString As String, _
    ByVal nSize As Long, _
    ByVal lpFileName As String) As Long

' Given a key it returns the associated value from an INI file.
' iniFileName should specify a valid path.
' jesus.aneiros@gmail.com
' 2020.06.11
Public Function readIniFileString(ByVal iniFileName As String, ByVal sectionName As String, ByVal keyName As String) As String

    Dim lResult As Long
    Dim retString As String * 255
    Dim retStringSize As Long

    ' The buffer
    retString = Space(255)
       
    ' Returns the number of caracters copied to the buffer retString
    lResult = GetPrivateProfileString(sectionName, keyName, "", retString, Len(retString), iniFileName)
       
    If (lResult) Then
        readIniFileString = Left$(retString, lResult)
    Else
        readIniFileString = ""
    End If

End Function

Public Sub test()
    Debug.Print readIniFileString(ThisWorkbook.Path & "\model_c.ini", "DB", "host")
    Debug.Print readIniFileString(ThisWorkbook.Path & "\model_c.ini", "EMAIL", "host")
End Sub

VBA Excel copy sheets from closed workbook

Option Explicit

' Copies sheets ranges (values and formats) from a closed workbook into
' a sheet on the opened workbook.
Private Sub copySheets(fileName As String, sheetName As String, dstSheetName As String, rng As String)

    Sheets(dstSheetName).Cells.Clear
   
    Dim srcWB As Workbook
   
    ' Open the source workbook and copy the values
    Set srcWB = Workbooks.Open(fileName)

    srcWB.Sheets(sheetName).Range(rng).Copy

    ThisWorkbook.Activate
   
    ' Paste values and formats
    With Sheets(dstSheetName)
        .Range(rng).PasteSpecial Paste:=xlPasteFormats
        .Range(rng).PasteSpecial Paste:=xlPasteColumnWidths
        .Range(rng).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    End With
   
    ' Get out of the copy mode
    Application.CutCopyMode = False
   
    ' Close the source workbook without saving
    srcWB.Close savechanges:=False

End Sub


' An example of use
Public Sub diff()
    Dim fileName As String
   
    ' Copy 2 sheets from 2 different files
   
    ' The first file
    ' Get the file names from a cell
    fileName = Sheets("Main").Range("B1").Value
    copySheets fileName, "Summary", "Summary", "A1:M26"
    copySheets fileName, "Day Positions", "DayPositions", "A1:N32"
   
    ' The second file
    fileName = Sheets("Main").Range("B2").Value
    copySheets fileName, "Summary", "SummaryNew", "A1:M26"
    copySheets fileName, "Day Positions", "DayPositionsNew", "A1:N32"
   
    ThisWorkbook.Sheets("Diff").Activate
    ThisWorkbook.Save
   
End Sub

Cleaning Excel Styles

The code below will clean the Excel styles:

Sub StyleKiller()
    Dim styT As Style
    Dim intRet As Integer

    For Each styT In ActiveWorkbook.Styles
        If Not styT.BuiltIn Then
            'intRet = MsgBox("Delete style '" & styT.Name & "'?", vbYesNo)
            'If intRet = vbYes Then styT.Delete
            styT.Delete
        End If
    Next styT
End Sub

Excel 2010 macros does not work after updates. Dec 9, 2014

Yesterday the buttons in one of our Excel 2010 files stopped working. Solved after reading this:

https://social.technet.microsoft.com/Forums/office/en-US/b8f0af82-0bb8-4799-aa62-1dbcbc5b7742/excel-2010-macros-does-not-work-after-updates-9dec2014?forum=excel

Excel Regular Expressions

Sub RegEx_Tester()
    Dim objRegExp_1 As Object
    Dim regExp_Matches As Object
    
    Dim strToSearch As String
    
    Set objRegExp_1 = CreateObject("vbscript.regexp")
    objRegExp_1.Global = True
    objRegExp_1.IgnoreCase = True
    objRegExp_1.Pattern = "[a-z,A-Z]*@[a-z,A-Z]*.com"
    
    strToSearch = "ABC@xyz.com"
    
    Set regExp_Matches = objRegExp_1.Execute(strToSearch)
    
    If regExp_Matches.Count = 1 Then
        MsgBox ("This string is a valid email address.")
    End If
    
End Sub

Add a digital signature to a file or macro project

http://office.microsoft.com/en-us/excel-help/add-a-digital-signature-to-a-file-or-macro-project-HP005249557.aspx?CTT=3