شرح دالة InStr , InStrRev البحث داخل النصوص باحتراف

[ابو جودي]

دالة InStr  من أهم وأقوى الدوال المستخدمة في التعامل مع السلاسل النصية

تستخدم لتحديد موضع أول ظهور لسلسلة فرعية داخل سلسلة نصية أخرى

يمكن الاعتماد عليها في التحقق من وجود رموز أو مقاطع نصية داخل محتوى مثل:

• التحقق من وجود امتداد ملف
• البحث عن كلمة في اسم ملف
• فحص تنسيقات
• أو كجزء من معالجة متقدمة للنصوص

الشكل العام:

 

InStr(Start, String1, String2 , Compare)

شرح المعاملات:

•  Start (اختياري):         >>--->  رقم الموضع الذي تبدأ منه عملية البحث في String1   (يبدأ من 1)
• String1:                      >>--->   السلسلة الأساسية التي يتم البحث بداخلها
• String2:                      >>--->   السلسلة الفرعية المطلوب العثور عليها
• Compare (اختياري):   >>--->   نوع المقارنة

يمكن استخدام:

•  vbBinaryCompare (افتراضي): مقارنة حساسة لحالة الأحرف
• vbTextCompare : مقارنة تتجاهل حالة الأحرف

 

الناتج:
ترجع الدالة رقم موضع أول تطابق (Starting from 1)  أو 0 إذا لم يتم العثور على أي تطابق

 

أمثلة توضيحية شاملة

1- اختبار حالات مختلفة للدالة InStr

    Dim strText As String
    Dim strSearch As String
    Dim intStart As Integer
    Dim intResult As Integer

    ' البحث عن أول ظهور للحرف "a"
    strText = "Mohesam"
    strSearch = "a"
    intStart = 1
    intResult = InStr(intStart, strText, strSearch)
    'M o h e s a m
    '1 2 3 4 5 6 7
	Debug.Print "الحالة 1: InStr(" & intStart & ", """ & strText & """, """ & strSearch & """) = " & intResult

    ' البحث من موقع مختلف
    intStart = 4
    intResult = InStr(intStart, strText, strSearch)
    Debug.Print "الحالة 2: InStr(" & intStart & ", """ & strText & """, """ & strSearch & """) = " & intResult

    ' البحث عن حرف غير موجود
    strSearch = "z"
    intStart = 1
    intResult = InStr(intStart, strText, strSearch)
    Debug.Print "الحالة 3: InStr(" & intStart & ", """ & strText & """, """ & strSearch & """) = " & intResult

    ' البحث في نص فارغ
    strText = ""
    strSearch = "a"
    intResult = InStr(1, strText, strSearch)
    Debug.Print "الحالة 4: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult

    ' البحث عن كلمة داخل جملة
    strText = "Access VBA"
    strSearch = "VBA"
    intResult = InStr(1, strText, strSearch)
    Debug.Print "الحالة 5: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult

    ' البحث المتكرر لنفس الكلمة
    strText = "abcabcabc"
    strSearch = "abc"
    intResult = InStr(1, strText, strSearch)
    Debug.Print "الحالة 6: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult

    ' البحث من منتصف السلسلة
    intResult = InStr(5, strText, strSearch)
    Debug.Print "الحالة 7: InStr(5, """ & strText & """, """ & strSearch & """) = " & intResult

    ' البحث مع اختلاف حالة الأحرف
    strText = "TestCase"
    strSearch = "case"
    intResult = InStr(1, strText, strSearch)
    Debug.Print "الحالة 8: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult & "   (Compare = Binary افتراضي)"

    ' استخدام vbTextCompare لتجاهل حالة الأحرف
    intResult = InStr(1, strText, strSearch, vbTextCompare)
    Debug.Print "الحالة 9: InStr(1, """ & strText & """, """ & strSearch & """, vbTextCompare) = " & intResult
Public Sub TestInStrFunction()

    Dim strText As String
    Dim strSearch As String
    Dim intStart As Integer
    Dim intResult As Integer
        
    Debug.Print String(70, "=")
    Debug.Print "اختبار دالة InStr"
    Debug.Print String(70, "=")
    
    ' الحالة 1: البحث عن حرف موجود من البداية
    strText = "Mohesam"
    strSearch = "a"
    intStart = 1
    intResult = InStr(intStart, strText, strSearch)
    Debug.Print "الحالة 1: InStr(" & intStart & ", """ & strText & """, """ & strSearch & """) = " & intResult
    
    ' الحالة 2: البحث بعد الموضع الابتدائي
    intStart = 4
    intResult = InStr(intStart, strText, strSearch)
    Debug.Print "الحالة 2: InStr(" & intStart & ", """ & strText & """, """ & strSearch & """) = " & intResult

    ' الحالة 3: البحث عن حرف غير موجود
    strSearch = "z"
    intStart = 1
    intResult = InStr(intStart, strText, strSearch)
    Debug.Print "الحالة 3: InStr(" & intStart & ", """ & strText & """, """ & strSearch & """) = " & intResult
    
    ' الحالة 4: سلسلة فارغة
    strText = ""
    strSearch = "a"
    intResult = InStr(1, strText, strSearch)
    Debug.Print "الحالة 4: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult
    
    ' الحالة 5: البحث عن كلمة كاملة
    strText = "Access VBA"
    strSearch = "VBA"
    intResult = InStr(1, strText, strSearch)
    Debug.Print "الحالة 5: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult
    
    ' الحالة 6: البحث عن نفس الكلمة مكررة
    strText = "abcabcabc"
    strSearch = "abc"
    intResult = InStr(1, strText, strSearch)
    Debug.Print "الحالة 6: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult

    ' الحالة 7: بدء البحث من منتصف النص
    intResult = InStr(5, strText, strSearch)
    Debug.Print "الحالة 7: InStr(5, """ & strText & """, """ & strSearch & """) = " & intResult
    
    ' الحالة 8: حساس لحالة الأحرف
    strText = "TestCase"
    strSearch = "case"
    intResult = InStr(1, strText, strSearch)
    Debug.Print "الحالة 8: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult & "   (Compare = Binary افتراضي)"
    
    ' الحالة 9: تجاهل حالة الأحرف باستخدام vbTextCompare
    intResult = InStr(1, strText, strSearch, vbTextCompare)
    Debug.Print "الحالة 9: InStr(1, """ & strText & """, """ & strSearch & """, vbTextCompare) = " & intResult
    
End Sub

 

2- ملخص سريع مباشر للحالات

Public Sub TestInStrCases()
    Debug.Print "=================================================="
    Debug.Print "اختبار دالة InStr"
    Debug.Print "=================================================="
    
    Debug.Print "الحالة 1: InStr(1, ""Mohesam"", ""a"") = "; InStr(1, "Mohesam", "a")
    Debug.Print "الحالة 2: InStr(4, ""Mohesam"", ""a"") = "; InStr(4, "Mohesam", "a")
    Debug.Print "الحالة 3: InStr(1, ""Mohesam"", ""z"") = "; InStr(1, "Mohesam", "z")
    Debug.Print "الحالة 4: InStr(1, """", ""a"") = "; InStr(1, "", "a")
    Debug.Print "الحالة 5: InStr(1, ""Access VBA"", ""VBA"") = "; InStr(1, "Access VBA", "VBA")
    Debug.Print "الحالة 6: InStr(1, ""abcabcabc"", ""abc"") = "; InStr(1, "abcabcabc", "abc")
    Debug.Print "الحالة 7: InStr(5, ""abcabcabc"", ""abc"") = "; InStr(5, "abcabcabc", "abc")
    Debug.Print "الحالة 8: InStr(1, ""TestCase"", ""case"") = "; InStr(1, "TestCase", "case")
    Debug.Print "الحالة 9: InStr(1, ""TestCase"", ""case"", vbTextCompare) = "; InStr(1, "TestCase", "case", vbTextCompare)
    
    Debug.Print "=================================================="
End Sub

 

استخدام احترافي البحث عن رموز داخل نص

دالة InStr يمكن توظيفها داخل دوال أكثر تقدما للبحث عن مجموعة من الرموز داخل نص معين

Public Function GetSymbolsInText(ByVal strText As String, ByVal arrSymbols As Variant, ByRef arrFound() As String) As Boolean

    Dim varSymbol As Variant
    Dim colFound As Collection
    Set colFound = New Collection

    ' البحث عن كل رمز في النص
    For Each varSymbol In arrSymbols
        If InStr(strText, varSymbol) > 0 Then
            On Error Resume Next ' لتجنب تكرار العناصر في المجموعة
            colFound.Add varSymbol, CStr(varSymbol)
            On Error GoTo 0
        End If
    Next

    ' تجهيز النتائج النهائية
    If colFound.Count > 0 Then
        ReDim arrFound(0 To colFound.Count - 1)
        Dim i As Long
        For i = 1 To colFound.Count
            arrFound(i - 1) = colFound(i)
        Next i
        GetSymbolsInText = True
    Else
        ReDim arrFound(-1 To -1)
        GetSymbolsInText = False
    End If
End Function

تجربة هذه الدالة

Public Sub TestGetSymbolsInText()
    Dim arrSymbols As Variant
    Dim arrFound() As String
    Dim bolFound As Boolean
    Dim strTest As String
    
    arrSymbols = Array(",", ";", "|", "/", "\", "-", "_")

    strTest = "Mohesam-2025/Report_Aug"

    ' تنفيذ البحث
    bolFound = GetSymbolsInText(strTest, arrSymbols, arrFound)

    ' عرض النتائج
    If bolFound Then
        Debug.Print "تم العثور على الرموز التالية:"
        Dim i As Long
        For i = LBound(arrFound) To UBound(arrFound)
            Debug.Print arrFound(i)
        Next i
    Else
        Debug.Print "لا يوجد أي رمز"
    End If
End Sub

 

Sub TestTextCompareBehavior()
    Dim str1 As String
    Dim str2 As String

    str1 = "Access"
    str2 = "access"

    ' المقارنة الثنائية (تراعي حالة الأحرف)
    ' - لن تنجح
     Debug.Print "BinaryCompare: "; InStr(1, str1, str2, vbBinaryCompare)

    ' المقارنة النصية (تتجاهل حالة الأحرف)
    ' - ستنجح
    Debug.Print "TextCompare:   "; InStr(1, str1, str2, vbTextCompare)
End Sub

الكود السابق يوضح الفرق بين نمطي المقارنة في دالة InStr

• vbBinaryCompare: يقارن مع مراعاة حالة الأحرف (case-sensitive)
• vbTextCompare: يقارن بدون مراعاة حالة الأحرف (case-insensitive)

النتيجة 0 في المقارنة الثنائية
تعني أن "access" لم يتم العثور عليها داخل "Access" بسبب اختلاف حالة الحروف
أما في TextCompare فتم العثور على "access" في بداية "Access" لأن الحالة تم تجاهلها

المعامل الرابع في InStr

InStr(Start, String1, String2 , Compare)

إذا لم يتم تحديد CompareMethod فإن Access يستخدم الإعداد الافتراضي (غالبا vbBinaryCompare)
لذلك ينصح دائما بتحديد نوع المقارنة صراحة لتفادي النتائج غير المتوقعة خاصة عند تجاهل حالة الأحرف

 

الخلاصــــــــــة

 

• InStr تعيد موضع أول ظهور لسلسلة داخل سلسلة أخرى (يبدأ من 1)
• تعيد  0 إذا لم يتم العثور على تطابق
• يمكن تخصيص نوع المقارنة باستخدام المعامل الرابع
• مفيدة لبناء دوال متقدمة لمعالجة النصوص والرموز
• لتجاهل حالة الأحرف استخدم vbTextCompare
• لا تعتمد على القيمة الافتراضية في Compare  حددها دائما لتفادي النتائج غير المتوقعة

هناك دالة مكملة لـ InStr تسمى InStrRev تقوم بالبحث من نهاية النص إلى بدايته
قد تكون مفيدة جدا في بعض الحالات (مثل البحث عن آخر امتداد أو آخر فاصل)

InStr(1, "file.name.txt", ".")       '  5
InStrRev("file.name.txt", ".")       '  10

بكده الشرح انتهى
ولتحقيق اكبر قدر ممكن من الاستفادة وفيما يخص النقطة التالية:
مفيدة لبناء دوال متقدمة لمعالجة النصوص والرموز

دى فكرة كود داخل وحدة نمطية عامة
فى الاعتماد على كل من InStr , InStrRev
اتركها لكم للاستمتاع بها

Option Compare Database
Option Explicit

Public Enum TextCase
    AsIs = 0    ' كما هو
    Lower = 1   ' أحرف صغيرة
    Upper = 2   ' أحرف كبيرة
    Proper = 3  ' أول حرف كبير
End Enum
' تعريفات الأنواع
Public Enum FilePartType
    FileNameWithExtension   ' اسم الملف مع الامتداد
    FileNameOnly            ' اسم الملف بدون الامتداد
    FileExtensionOnly       ' الامتداد بدون النقطة
    FileExtensionWithDot    ' الامتداد مع النقطة
    FullFolderPath          ' المسار الكامل للمجلد
    ContainingFolderName    ' اسم المجلد الحاوي فقط
    RootDrive               ' الجذر (مثل C:\ أو اسم السيرفر)
    VersionOnly             ' الإصدار فقط (مثل v1.2)
    DateOnly                ' التاريخ فقط (مثل 2025-07-17)
    FullUNCPath             ' المسار الكامل بصيغة UNC
    FileURL                 ' المسار بصيغة URL
    FileNameWithoutVersionOrDate ' اسم الملف بدون الإصدار أو التاريخ
    ServerAndShare          ' السيرفر والمشاركة من مسار UNC
End Enum



' كائنات على مستوى الوحدة لتحسين الأداء
Private objFSO As Object
Private objRegEx As Object

' الدالة الرئيسية لاستخراج أجزاء المسار
Public Function ExtractFilePartPro( _
    ByVal strPath As String, _
    Optional ByVal enmPart As FilePartType = FileNameWithExtension, _
    Optional ByVal enuTextCase As TextCase = AsIs, _
    Optional ByRef strVersion As String = "", _
    Optional ByRef strDate As String = "", _
    Optional ByRef strError As String = "" _
) As String

    Dim strResult As String
    Dim lngPos As Long
    Dim strFileName As String
    Dim strFolder As String
    Dim strExt As String
    Dim strParent As String
    Dim colMatches As Object
    Dim vMatch As Variant

    ' تهيئة رسالة الخطأ إلى فارغة
    strError = ""

    ' إنشاء الكائنات إذا لم تكن موجودة
    If objFSO Is Nothing Then Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objRegEx Is Nothing Then
        Set objRegEx = CreateObject("VBScript.RegExp")
        With objRegEx
            .Global = True
            .IgnoreCase = True
            ' نمط محسن لدعم إصدارات مع أحرف وتواريخ بصيغ مختلفة
            .Pattern = "(v[\d\.]+[a-zA-Z-]*)|((?:19|20)\d{2}[-_/]?\d{2}[-_/]?\d{2}|\d{8})"
        End With
    End If

    On Error GoTo ErrHandler

    ' تنظيف المسار
    strPath = Trim(strPath)

    ' التحقق من المسار الفارغ
    If strPath = "" Then
        strError = "المسار فارغ"
        ExtractFilePartPro = ""
        Exit Function
    End If

    ' استخراج اسم الملف
    If objFSO.FileExists(strPath) Or InStrRev(strPath, "\") > 0 Then
        strFileName = Mid(strPath, InStrRev(strPath, "\") + 1)
    Else
        strFileName = strPath
    End If

    ' استخراج المسار الكامل للمجلد
    strFolder = Left(strPath, Len(strPath) - Len(strFileName))

    ' استخراج الامتداد (يدعم الامتدادات المركبة مثل .tar.gz)
    If InStr(strFileName, ".") > 0 Then
        lngPos = InStrRev(strFileName, ".")
        strExt = Mid(strFileName, lngPos)
        If LCase(strExt) = ".gz" And InStrRev(strFileName, ".tar.gz") > 0 Then
            strExt = ".tar.gz"
        End If
    Else
        strExt = ""
    End If

    ' استخراج اسم المجلد الحاوي
    If Right(strFolder, 1) = "\" Then strFolder = Left(strFolder, Len(strFolder) - 1)
    If InStrRev(strFolder, "\") > 0 Then
        strParent = Mid(strFolder, InStrRev(strFolder, "\") + 1)
    Else
        strParent = ""
    End If

    ' استخراج الإصدار والتاريخ باستخدام RegExp
    If objRegEx.Test(strFileName) Then
        Set colMatches = objRegEx.Execute(strFileName)
        For Each vMatch In colMatches
            If Left(LCase(vMatch), 1) = "v" Then
                strVersion = vMatch
            Else
                strDate = vMatch
            End If
        Next
    End If

    ' اختيار الجزء المطلوب
    Select Case enmPart
        Case FileNameWithExtension
            strResult = strFileName

        Case FileNameOnly
            If strExt <> "" Then
                strResult = Left(strFileName, Len(strFileName) - Len(strExt))
            Else
                strResult = strFileName
            End If

        Case FileExtensionOnly
            If strExt <> "" Then strResult = Mid(strExt, 2)

        Case FileExtensionWithDot
            strResult = strExt

        Case FullFolderPath
            strResult = strFolder

        Case ContainingFolderName
            strResult = strParent

        Case RootDrive
            If Left(strPath, 2) = "\\" Then
                strResult = Split(strPath, "\")(2) ' اسم السيرفر فقط
            Else
                strResult = Left(strPath, 3)
            End If

        Case VersionOnly
            strResult = strVersion

        Case DateOnly
            strResult = strDate

        Case FullUNCPath
            strResult = strPath

        Case FileURL
            If Left(strPath, 2) = "\\" Then
                strResult = "file://" & Replace(strPath, "\", "/")
            Else
                strResult = "file:///" & Replace(strPath, "\", "/")
            End If

        Case FileNameWithoutVersionOrDate
            strResult = objRegEx.Replace(strFileName, "")

        Case ServerAndShare
            If Left(strPath, 2) = "\\" Then
                Dim arrParts As Variant
                arrParts = Split(strPath, "\")
                If UBound(arrParts) >= 3 Then
                    strResult = "\\" & arrParts(2) & "\" & arrParts(3)
                Else
                    strResult = ""
                End If
            Else
                strResult = ""
            End If
    End Select

    ' تنسيق النص حسب الخيار المحدد
    Select Case enuTextCase
        Case Lower
            strResult = LCase(strResult)
        Case Upper
            strResult = UCase(strResult)
        Case Proper
            strResult = StrConv(strResult, vbProperCase)
        Case Else
            ' AsIs, لا تغيير
    End Select

    ExtractFilePartPro = strResult

ExitHere:
    Set colMatches = Nothing
    Exit Function

ErrHandler:
    strError = "خطأ: " & Err.Description
    ExtractFilePartPro = ""
    Resume ExitHere
End Function

' روتين اختبار موسع
Public Sub TestEnhanced()
    Dim strPath As String
    Dim strUNCPath As String
    Dim strResPath As String
    Dim strRes As String
    Dim strVer As String
    Dim strDat As String
    Dim strError As String

    ' تعيين مسارات الاختبار
    strPath = "C:\Test\MyDataBase\Officena.Accdb"
    strUNCPath = "\\Server\Myhiba\Officena.Accdb"
    strResPath = "C:\Test\MyFile_v3.4_2025-07-17.tar.gz"
    
    Debug.Print String(70, "=")
    Debug.Print "اختبارات استخراج أجزاء المسار"
    Debug.Print String(70, "=")

    ' اختبار الأجزاء الأساسية
    Debug.Print "اختبار الأجزاء الأساسية"
    Debug.Print String(70, "-")
    
    Debug.Print " الاسم مع الامتداد          : " & ExtractFilePartPro(strPath, FileNameWithExtension)
    Debug.Print " الاسم فقط                 : " & ExtractFilePartPro(strPath, FileNameOnly)
    Debug.Print " الامتداد فقط              : " & ExtractFilePartPro(strPath, FileExtensionOnly)
    Debug.Print " الامتداد مع النقطة        : " & ExtractFilePartPro(strPath, FileExtensionWithDot)
    Debug.Print " اسم المجلد الحاوي        : " & ExtractFilePartPro(strPath, ContainingFolderName)
    Debug.Print " المسار بدون اسم الملف    : " & ExtractFilePartPro(strPath, FullFolderPath)
    Debug.Print " الجذر                    : " & ExtractFilePartPro(strPath, RootDrive)
    Debug.Print " المسار بصيغة UNC         : " & ExtractFilePartPro(strUNCPath, FullUNCPath)
    Debug.Print " المسار بصيغة URL         : " & ExtractFilePartPro(strUNCPath, FileURL)

    Debug.Print String(70, "-")

    ' اختبار استخراج الإصدار والتاريخ
    strRes = ExtractFilePartPro(strResPath, FileNameOnly, AsIs, strVer, strDat)
    Debug.Print "اختبار استخراج الإصدار والتاريخ"
    Debug.Print " الاسم                     : " & strRes
    Debug.Print " الإصدار                   : " & strVer
    Debug.Print " التاريخ                  : " & strDat

    ' اختبار الخيارات الجديدة
    Debug.Print " FileNameWithoutVersionOrDate: " & ExtractFilePartPro(strResPath, FileNameWithoutVersionOrDate)
    Debug.Print " ServerAndShare            : " & ExtractFilePartPro(strUNCPath, ServerAndShare)

    ' اختبار معالجة الأخطاء
    strRes = ExtractFilePartPro("", FileNameWithExtension, AsIs, , , strError)
    Debug.Print " Empty path result         : " & strRes & ", Error: " & strError

    strRes = ExtractFilePartPro("C:\Invalid\Path", FileNameWithExtension, AsIs, , , strError)
    Debug.Print " Invalid path result       : " & strRes & ", Error: " & strError

    ' اختبار تنسيق الحروف
    Debug.Print " Upper case                : " & ExtractFilePartPro(strPath, FileNameWithExtension, Upper)

    Debug.Print "======================================================"
End Sub