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
Friday, June 12, 2020
Thursday, June 11, 2020
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
' 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
Subscribe to:
Posts (Atom)