Useful vba code snipits

gitch10

Different approach to output

# Set the path to your Excel workbook

$excelFilePath = "C:\Path\To\Your\Excel\File.xlsx"

# Set the name of the worksheet you want to read data from

$worksheetName = "Sheet1"

# Set the path where you want to save the CSV file

$csvFilePath = "C:\Path\To\Your\Output\File.csv"

# Create a new Excel application object

$excel = New-Object -ComObject Excel.Application

# Make Excel visible (optional)

$excel.Visible = $true

# Open the workbook

$workbook = $excel.Workbooks.Open($excelFilePath)

# Select the worksheet

$worksheet = $workbook.Worksheets.Item($worksheetName)

# Get the last row and column in the worksheet

$lastRow = $worksheet.UsedRange.Rows.Count

$lastColumn = $worksheet.UsedRange.Columns.Count

# Create a StringBuilder object to store CSV data

$stringBuilder = New-Object -TypeName System.Text.StringBuilder

# Iterate through each row in the worksheet

for ($rowIndex = 1; $rowIndex -le $lastRow; $rowIndex++) {

  # Iterate through each column in the row

  for ($colIndex = 1; $colIndex -le $lastColumn; $colIndex++) {

    # Append cell value to StringBuilder object

    $cellValue = $worksheet.Cells.Item($rowIndex, $colIndex).Text

    $stringBuilder.Append("$cellValue,")

  }

  # Append newline character after each row

  $stringBuilder.AppendLine()

}

# Export data to CSV file

$stringBuilder.ToString() | Out-File -FilePath $csvFilePath -Encoding utf8

# Close the workbook without saving changes

$workbook.Close($false)

# Close Excel application

$excel.Quit()

# Release COM objects

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($worksheet) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($workbook) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel) | Out-Null

gitch10

# Set the path to your Excel workbook

$excelFilePath = "C:\Path\To\Your\Excel\File.xlsx"

# Set the name of the worksheet you want to read data from

$worksheetName = "Sheet1"

# Set the path where you want to save the CSV file

$csvFilePath = "C:\Path\To\Your\Output\File.csv"

# Create a new Excel application object

$excel = New-Object -ComObject Excel.Application

# Make Excel visible (optional)

$excel.Visible = $true

# Open the workbook

$workbook = $excel.Workbooks.Open($excelFilePath)

# Select the worksheet

$worksheet = $workbook.Worksheets.Item($worksheetName)

# Get the range of used cells in the worksheet

$usedRange = $worksheet.UsedRange

$rowCount = $usedRange.Rows.Count

$columnCount = $usedRange.Columns.Count

# Open or create the CSV file

$csvFile = New-Object -TypeName System.IO.StreamWriter -ArgumentList $csvFilePath

# Loop through each row in the worksheet

for ($row = 1; $row -le $rowCount; $row++) {

  $rowData = @()

  # Loop through each column in the row

  for ($col = 1; $col -le $columnCount; $col++) {

    # Get the value of the cell and add it to the row data array

    $cellValue = $worksheet.Cells.Item($row, $col).Text

    $rowData += $cellValue

  }

  # Convert the row data array to a comma-separated string and write it to the CSV file

  $csvFile.WriteLine($rowData -join ",")

}

# Close the CSV file

$csvFile.Close()

# Close the workbook without saving changes

$workbook.Close($false)

# Close Excel application

$excel.Quit()

# Release COM objects

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($worksheet) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($workbook) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel) | Out-Null

gitch10

# Set the path to your Excel workbook

$excelFilePath = "C:\Path\To\Your\Excel\File.xlsx"

# Set the name of the worksheet you want to read data from

$worksheetName = "Sheet1"

# Set the name of the named range you want to use

$namedRange = "MyNamedRange"

# Set the path where you want to save the CSV file

$csvFilePath = "C:\Path\To\Your\Output\File.csv"

# Create a new Excel application object

$excel = New-Object -ComObject Excel.Application

# Make Excel visible (optional)

$excel.Visible = $true

# Open the workbook

$workbook = $excel.Workbooks.Open($excelFilePath)

# Select the worksheet

$worksheet = $workbook.Worksheets.Item($worksheetName)

# Get the named range

$range = $worksheet.Range($namedRange)

# Get the row and column counts from the range

$rowCount = $range.Rows.Count

$columnCount = $range.Columns.Count

# Open or create the CSV file

$csvFile = New-Object -TypeName System.IO.StreamWriter -ArgumentList $csvFilePath

# Loop through each row in the range

for ($row = 1; $row -le $rowCount; $row++) {

  $rowData = @()

  # Loop through each column in the row

  for ($col = 1; $col -le $columnCount; $col++) {

    # Get the value of the cell and add it to the row data array

    $cellValue = $range.Cells.Item($row, $col).Text

    $rowData += $cellValue

  }

  # Convert the row data array to a comma-separated string and write it to the CSV file

  $csvFile.WriteLine($rowData -join ",")

}

# Close the CSV file

$csvFile.Close()

# Close the workbook without saving changes

$workbook.Close($false)

# Close Excel application

$excel.Quit()

# Release COM objects

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($range) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($worksheet) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($workbook) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel) | Out-Null

gitch10

# Set the path to your Excel workbook

$excelFilePath = "C:\Path\To\Your\Excel\File.xlsx"

# Set the name of the worksheet you want to read data from

$worksheetName = "Sheet1"

# Set the name of the named range you want to use

$namedRange = "MyNamedRange"

# Set the path where you want to save the CSV file

$csvFilePath = "C:\Path\To\Your\Output\File.csv"

# Create a new Excel application object

$excel = New-Object -ComObject Excel.Application

# Make Excel visible (optional)

$excel.Visible = $true

# Open the workbook

$workbook = $excel.Workbooks.Open($excelFilePath)

# Select the worksheet

$worksheet = $workbook.Worksheets.Item($worksheetName)

# Get the named range

$range = $worksheet.Range($namedRange)

# Get the row and column counts from the range

$rowCount = $range.Rows.Count

$columnCount = $range.Columns.Count

# Open or create the CSV file

$csvFile = New-Object -TypeName System.IO.StreamWriter -ArgumentList $csvFilePath

# Loop through each row in the range

for ($row = 1; $row -le $rowCount; $row++) {

  $rowData = @()

  # Loop through each column in the row

  for ($col = 1; $col -le $columnCount; $col++) {

    # Get the value of the cell and add it to the row data array

    $cellValue = $range.Cells.Item($row, $col).Text

    $rowData += $cellValue

  }

  # Convert the row data array to a pipe-separated string and write it to the CSV file

  $csvFile.WriteLine($rowData -join "|")

}

# Close the CSV file

$csvFile.Close()

# Close the workbook without saving changes

$workbook.Close($false)

# Close Excel application

$excel.Quit()

# Release COM objects

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($range) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($worksheet) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($workbook) | Out-Null

[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel) | Out-Null

gitch10

Sub ExportNamedRangeToTextFile()

  Dim filePath As String

  Dim cell As Range

  Dim delimiter As String

  Dim fileNum As Integer

   

  ' Set the file path where you want to save the text file

  filePath = "C:\YourFolder\YourFile.txt"

   

  ' Define the delimiter

  delimiter = "|"

   

  ' Open a new text file for writing

  fileNum = FreeFile

  Open filePath For Output As #fileNum

   

  ' Loop through each cell in the named range

  For Each cell In ThisWorkbook.Names("YourNamedRange").RefersToRange

    ' Write the cell value to the text file

    Print #fileNum, cell.Value;

    ' Print the delimiter except for the last cell in each row

    If cell.Column <> ThisWorkbook.Names("YourNamedRange").RefersToRange.Columns.Count Then

      Print #fileNum, delimiter;

    End If

  Next cell

   

  ' Close the text file

  Close #fileNum

   

  MsgBox "Export complete."

   

End Sub

gitch10

Sub ExportNamedRangeToTextFile()

  Dim filePath As String

  Dim cell As Range

  Dim delimiter As String

  Dim fileNum As Integer

   

  ' Set the file path where you want to save the text file

  filePath = "C:\YourFolder\YourFile.txt"

   

  ' Define the delimiter

  delimiter = "|"

   

  ' Open a new text file for writing

  fileNum = FreeFile

  Open filePath For Output As #fileNum

   

  ' Loop through each cell in the named range

  For Each cell In ThisWorkbook.Names("YourNamedRange").RefersToRange

    ' Write the cell value to the text file

    Print #fileNum, cell.Value;

    ' Print the delimiter except for the last cell in each row

    If cell.Column <> ThisWorkbook.Names("YourNamedRange").RefersToRange.Columns.Count Then

      Print #fileNum, delimiter;

    End If

  Next cell

   

  ' Add a carriage return after each row

  Print #fileNum,

   

  ' Close the text file

  Close #fileNum

   

  MsgBox "Export complete."

   

End Sub

gitch10

Sub ExportSheet1RowsToTextFile()

  Dim filePath As String

  Dim rowNum As Long

  Dim colNum As Long

  Dim delimiter As String

  Dim fileNum As Integer

   

  ' Set the file path where you want to save the text file

  filePath = "C:\YourFolder\YourFile.txt"

   

  ' Define the delimiter

  delimiter = "|"

   

  ' Open a new text file for writing

  fileNum = FreeFile

  Open filePath For Output As #fileNum

   

  ' Loop through each row in Sheet1

  For rowNum = 1 To ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count

    ' Loop through each column in the current row

    For colNum = 1 To ThisWorkbook.Sheets("Sheet1").UsedRange.Columns.Count

      ' Get the value of the current cell

      cellValue = ThisWorkbook.Sheets("Sheet1").Cells(rowNum, colNum).Value

       

      ' Write the cell value to the text file

      If colNum > 1 Then

        Print #fileNum, delimiter; cellValue;

      Else

        Print #fileNum, cellValue;

      End If

    Next colNum

     

    ' Move to the next line in the text file after each row

    Print #fileNum,

     

  Next rowNum

   

  ' Close the text file

  Close #fileNum

   

  MsgBox "Export complete."

   

End Sub

gitch10

Sub ExportNamedRangeRowsToTextFile()

  Dim filePath As String

  Dim rowNum As Long

  Dim colNum As Long

  Dim delimiter As String

  Dim fileNum As Integer

  Dim cellValue As Variant

  Dim namedRange As Range

   

  ' Set the file path where you want to save the text file

  filePath = "C:\YourFolder\YourFile.txt"

   

  ' Define the delimiter

  delimiter = "|"

   

  ' Set the named range

  Set namedRange = ThisWorkbook.Names("YourNamedRange").RefersToRange

   

  ' Open a new text file for writing

  fileNum = FreeFile

  Open filePath For Output As #fileNum

   

  ' Loop through each row in the named range

  For rowNum = 1 To namedRange.Rows.Count

    ' Loop through each column in the current row

    For colNum = 1 To namedRange.Columns.Count

      ' Get the value of the current cell

      cellValue = namedRange.Cells(rowNum, colNum).Value

       

      ' Write the cell value to the text file

      If colNum > 1 Then

        Print #fileNum, delimiter; cellValue;

      Else

        Print #fileNum, cellValue;

      End If

    Next colNum

     

    ' Move to the next line in the text file after each row

    Print #fileNum,

     

  Next rowNum

   

  ' Close the text file

  Close #fileNum

   

  MsgBox "Export complete."

   

End Sub

gitch10

# Source and destination folders

$sourceFolder = "C:\SourceFolder"

$destinationFolder = "C:\DestinationFolder"

# Get all .doc and .docx files from the source folder

$files = Get-ChildItem $sourceFolder -Filter *.doc, *.docx

# Copy each file to the destination folder

foreach ($file in $files) {

  Copy-Item $file.FullName -Destination $destinationFolder

}

gitch10

Sub CopyWordFiles()

  Dim sourceFolder As String

  Dim destinationFolder As String

  Dim fileExtension As String

  Dim objFSO As Object

  Dim objFolder As Object

  Dim objSubFolder As Object

  Dim objFile As Object

  ' Define the source folder path

  sourceFolder = "C:\SourceFolder\"

   

  ' Define the destination folder path

  destinationFolder = "C:\DestinationFolder\"

   

  ' Define the file extension to search for

  fileExtension = "*.doc*"

   

  ' Create a File System Object

  Set objFSO = CreateObject("Scripting.FileSystemObject")

   

  ' Get the source folder

  Set objFolder = objFSO.GetFolder(sourceFolder)

   

  ' Loop through each file in the source folder

  For Each objFile In objFolder.Files

    ' Check if the file has the specified extension

    If objFSO.GetExtensionName(objFile.Path) Like "doc*" Then

      ' Copy the file to the destination folder

      objFSO.CopyFile objFile.Path, destinationFolder

    End If

  Next objFile

   

  ' Recursively search through subfolders

  For Each objSubFolder In objFolder.SubFolders

    ' Call a recursive function to search through subfolders

    RecursiveSearch objSubFolder, destinationFolder

  Next objSubFolder

   

  MsgBox "File copy completed."

End Sub

Sub RecursiveSearch(ByVal objFolder As Object, ByVal destinationFolder As String)

  Dim objFSO As Object

  Dim objSubFolder As Object

  Dim objFile As Object

   

  ' Create a File System Object

  Set objFSO = CreateObject("Scripting.FileSystemObject")

   

  ' Loop through each file in the current folder

  For Each objFile In objFolder.Files

    ' Check if the file has the specified extension

    If objFSO.GetExtensionName(objFile.Path) Like "doc*" Then

      ' Copy the file to the destination folder

      objFSO.CopyFile objFile.Path, destinationFolder

    End If

  Next objFile

   

  ' Recursively search through subfolders

  For Each objSubFolder In objFolder.SubFolders

    RecursiveSearch objSubFolder, destinationFolder

  Next objSubFolder

End Sub

gitch10

Remove all alpha chars !

Function RemoveAlphaCharacters(inputString As String) As String
Dim resultString As String
Dim i As Integer

For i = 1 To Len(inputString)
    If Not IsAlpha(Mid(inputString, i, 1)) Then
        resultString = resultString & Mid(inputString, i, 1)
    End If
Next i

RemoveAlphaCharacters = resultString

End Function

Function IsAlpha(character As String) As Boolean
IsAlpha = character Like "[A-Za-z]"
End Function

gitch10

String into SQL

Sub AddNumbersToSQLCriteriaAndOutput()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim criteria As String
Dim conn As Object
Dim rs As Object
Dim strSQL As String

' Assuming the numbers are in column A starting from the second row
Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

' Find the last row with data in column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Initialize the criteria string
criteria = ""

' Loop through each cell in column A and add the number to the criteria string
For i = 2 To lastRow ' Assuming data starts from row 2
    If IsNumeric(ws.Cells(i, 1).Value) Then
        criteria = criteria & ws.Cells(i, 1).Value & ","
    End If
Next i

' Remove the trailing comma
If Len(criteria) > 0 Then
    criteria = Left(criteria, Len(criteria) - 1)
End If

' Your SQL statement with the criteria added
strSQL = "SELECT * FROM YourTable WHERE YourColumn IN (" & criteria & ");"

' Open a connection to your database (replace the connection string and provider as necessary)
Set conn = CreateObject("ADODB.Connection")
conn.Open "your_connection_string_here"

' Execute the SQL statement
Set rs = conn.Execute(strSQL)

' Paste the results into a specified column (e.g., column B starting from row 2)
ws.Range("B2").CopyFromRecordset rs

' Close the recordset and connection
rs.Close
conn.Close

End Sub