asked on
ASKER
ASKER
ASKER
Option Explicit
Const DirectoryToClean = "C:\Data\Experts Exchange\Excel\ToClean"
Const CleanedDirectory = "C:\Data\Experts Exchange\Excel\Cleaned"
Public Function StripNonAsciiChars(ByVal InputString As String) As String
Dim i As Integer
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = "[^a-zA-Z0-9 ]"
StripNonAsciiChars = Trim(RegEx.Replace(InputString, ""))
End With
End Function
Sub CleanWorkBook()
Dim lastRow As Long
lastRow = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
Dim lastCol As Integer
Dim colIdx As Integer
Dim rowIdx As Long
Dim sht As Worksheet
Dim strCell As String
Dim bHaveChars As Boolean
Set sht = ActiveSheet
For rowIdx = 1 To lastRow
If rowIdx > lastRow Then Exit For
bHaveChars = False
lastCol = Cells(rowIdx, ActiveSheet.Columns.Count).End(xlToLeft).Column
'Debug.Print "Checking Row: " & CStr(rowIdx) & " ... Cols: " & CStr(lastCol)
For colIdx = 1 To lastCol
strCell = StripNonAsciiChars(sht.Cells(rowIdx, colIdx))
sht.Cells(rowIdx, colIdx) = strCell
If Len(strCell) > 0 Then bHaveChars = True
Next
If bHaveChars = False Then
' delete the row
Rows(rowIdx).Delete
rowIdx = rowIdx - 1
lastRow = lastRow - 1
End If
Next
End Sub
Sub CleanDirectory()
Dim idx As Integer
Dim fso As Object '// Scripting.fileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fld As Object '// Scripting.folder
Set fld = fso.GetFolder(DirectoryToClean)
Dim fl As Object '// Scripting.File
Dim wb As Workbook
Dim ToCleanName As String
Dim CleanedName As String
For Each fl In fld.Files
ToCleanName = DirectoryToClean & "\" & fl.Name
CleanedName = CleanedDirectory & "\" & fl.Name
Debug.Print "Cleaning: " & fl.Name
Application.StatusBar = "Cleaning: " & ToCleanName
DoEvents
Set wb = Workbooks.Open(ToCleanName, , , , , , , , , , , , , , True)
CleanWorkBook
wb.SaveAs Filename:=CleanedName
wb.Close saveChanges:=True
Next
Application.StatusBar = "Ready."
Debug.Print "Done!"
End Sub
ASKER
Option Explicit
Const DirectoryToClean = "C:\Data\Experts Exchange\Excel\ToClean"
Const CleanedDirectory = "C:\Data\Experts Exchange\Excel\Cleaned"
Public Function StripNonAsciiChars(ByVal InputString As String) As String
Dim i As Integer
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = "[^a-zA-Z0-9 ]"
StripNonAsciiChars = Trim(RegEx.Replace(InputString, ""))
End With
End Function
' Do not execute this macro directly
' it is called from CleanDirectory
Sub CleanWorkBook()
Dim lastRow As Long
lastRow = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
Dim lastCol As Integer
Dim colIdx As Integer
Dim rowIdx As Long
Dim sht As Worksheet
Dim strCell As String
Dim bHaveChars As Boolean
Dim bCorruptionDetected As Boolean
Set sht = ActiveSheet
bCorruptionDetected = False
For rowIdx = 1 To lastRow
If rowIdx > lastRow Then Exit For
' if no corruption in the first 10 lines, assume the rest of the file is ok
If rowIdx > 10 And bCorruptionDetected = False Then
Exit For
End If
bHaveChars = False
lastCol = Cells(rowIdx, ActiveSheet.Columns.Count).End(xlToLeft).Column
'Debug.Print "Checking Row: " & CStr(rowIdx) & " ... Cols: " & CStr(lastCol)
For colIdx = 1 To lastCol
strCell = StripNonAsciiChars(sht.Cells(rowIdx, colIdx))
If Len(strCell) < Len(sht.Cells(rowIdx, colIdx)) Then
sht.Cells(rowIdx, colIdx) = strCell
bCorruptionDetected = True
End If
If Len(strCell) > 0 Then bHaveChars = True
Next
If bHaveChars = False Then
' delete the row
Rows(rowIdx).Delete
rowIdx = rowIdx - 1
lastRow = lastRow - 1
End If
Next
End Sub
Sub CleanDirectory()
Dim idx As Integer
Dim fso As Object '// Scripting.fileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fld As Object '// Scripting.folder
Set fld = fso.GetFolder(DirectoryToClean)
Dim fl As Object '// Scripting.File
Dim wb As Workbook
Dim ToCleanName As String
Dim CleanedName As String
For Each fl In fld.Files
ToCleanName = DirectoryToClean & "\" & fl.Name
CleanedName = CleanedDirectory & "\" & fl.Name
Debug.Print "Cleaning: " & fl.Name
Application.StatusBar = "Cleaning: " & ToCleanName
DoEvents
Application.ScreenUpdating = False
Set wb = Workbooks.Open(ToCleanName, , , , , , , , , , , , , , True)
CleanWorkBook
wb.SaveAs Filename:=CleanedName
wb.Close saveChanges:=True
Application.ScreenUpdating = True
Next
Application.ScreenUpdating = True
Application.StatusBar = "Ready."
Debug.Print "Done!"
End Sub
ASKER
ASKER
Visual Basic for Applications (VBA) enables building user-defined functions (UDFs), automating processes and accessing Windows API and other low-level functionality through dynamic-link libraries (DLLs). VBA is closely related to Visual Basic and uses the Visual Basic Runtime Library, but it can normally only run code within a host application rather than as a standalone program. It can, however, be used to control one application from another via OLE Automation. VBA is built into most Microsoft Office applications.
TRUSTED BY
For #2, do you want multiple non-alpha characters removed (e.g. ** or ++)?