0 votes
in VBA by Beginner (5 points)
edited by

Hi,

To open a Windows browser which displays files beginning by specific string I used Getopenfilename function, but the file name returned after selecting the file in the Windows browser is with SOH characters. To delete SOH special characters I developed a function using RegExp but the pattern used is a source of error while it is right on RegExp website tester

My code in a VBA module

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Type OPENFILENAME
lStructSize       As Long
hwndOwner         As Long
hInstance         As Long
lpstrFilter       As String
lpstrCustomFilter As String
nMaxCustFilter    As Long
nFilterIndex      As Long
lpstrFile         As String
nMaxFile          As Long
lpstrFileTitle    As String
nMaxFileTitle     As Long
lpstrInitialDir   As String
lpstrTitle        As String
flags             As Long
nFileOffset       As Integer
nFileExtension    As Integer
lpstrDefExt       As String
lCustData         As Long
lpfnHook          As Long
lpTemplateName    As String
End Type

Public typOpenFile As OPENFILENAME

Public Function RegParse(psStr As String, psPattern As String) As String

Dim oRegex As New RegExp
Dim sStr As String, sPattern As String

sStr2 = Replace(psStr, Chr(1), "", Compare:=vbBinaryCompare)
Debug.Print sStr2


sPattern = psPattern
    With oRegex
    .Global = True     'restricting regex to find only first match.
    .IgnoreCase = True  'ignoring cases while regex engine performs the search.
    .Pattern = sPattern

    If .Test(psStr) Then              'Testing if the pattern matches or not
        sStr = .Execute(psStr)(0)     'will provide the String which matches with Regex 
        sStr1 = .Replace(psStr, "$1") '.Replace function will replace the String with whatever is in the first set of braces - $X
    End If
End With

Exit_:

RegParse = sStr
Exit Function

Err_:
sStr = ""
gsMsg = Err.Number & " : " & Err.Description & Chr(13) & "Process aborted"
MsgBox gsMsg, vbCritical, "Error message"
GoTo Exit_

End Function


Public Function mfOpenFileDialog(psPathDir As String, Optional psFileCrit As String) As Boolean

Dim lReturn As Long
Dim strFilter As String
Dim sFileSelected As String
Dim bOk As Boolean

bOk = True

typOpenFile.lStructSize = Len(typOpenFile)
strFilter = "Text File (*" & psFileCrit & "*.csv)" & Chr(0) & "*" & psFileCrit & "*.csv" & Chr(0) '--> Define your filter here

With typOpenFile
    .lpstrFilter = strFilter
    .nFilterIndex = 1
    .lpstrFile = String(257, 0)
    .nMaxFile = Len(.lpstrFile) - 1
    .lpstrFileTitle = .lpstrFile
    .nMaxFileTitle = .nMaxFile
    .lpstrInitialDir = psPathDir
    .lpstrTitle = "My FileFilter Open"
    .flags = 0
End With

If GetOpenFileName(typOpenFile) = 0 Then
    MsgBox "No file selected", vbCritical, "Error message"
    bOk = False
End If

Exit_:

mfOpenFileDialog = bOk
Exit Function

Err_:

bOk = False
gsMsg = "Function mfOpenFileDialog" & Chr(13) & Err.Number & Chr(13) & Err.Description
MsgBox gsMsg, vbCritical, "Error message"
GoTo Exit_

End Function

And the code on click on event

 

sPathDefault = "c:\Extraction"
sFileCrit = "rapport_"
If mfOpenFileDialog(sPathDefault, sFileCrit) = False Then GoTo Exit_
sPattern = "(^.*?(?=\x01))(\x01*)"
sFileName = RegParse(typOpenFile.lpstrFile, sPattern)

Thanks by advance for help

 

1 Answer

+1 vote
by Beginner (132 points)
selected by
 
Best answer

Have you tried this?

sFileName = Replace(typOpenFile.lpstrFile, Chr(1), vbNullString)

 

by Beginner (5 points)
edited by

In fact, the special characters are not chr(1) but chr(0) or x00
I tested with this function 

    Public Function mfShowChar(psStr As String)
      Dim i As Integer
      Dim arrChar() As Integer

      For i = 1 To Len(psStr)
         ReDim Preserve arrChar(i)
         ArrChar(i) = Asc(Mid(psStr, i)) 
      Next

     End Function

And the both solutions work

  •  sStr = Replace(typOpenFile.lpstrFile, Chr(0), vbNullString)
  •  RegExp but with sPattern = "(^.*?(?=\x00))(\x00*)"

Thanks for,your help JWoolley

Welcome to wellsr Q&A
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.

Register

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...