' ////////////////////////////////////////////////////////////////
' // *Autor: *PsYkE1* (miguelin.majo@gmail.com)                 //
' // *Podeis agrandar o reducir el codigo, siempre y cuando se  //
' // respete la autoria y se me comuniquen esos cambios.        //
' // *Agradecimientos a BlackZeroX                              //
' // *Visita http://foro.rthacker.net                           //
' ////////////////////////////////////////////////////////////////
Option Explicit
Public Sub Computer_Talk(ByVal sText As String, Optional ByVal lVelocity As Long = 0)
    If lVelocity < -10 Or lVelocity > 10 Then Exit Sub
    Dim oTalkComputer As Object
    Set oTalkComputer = CreateObject("Sapi.spVoice")
    If oTalkComputer Is Nothing Then Exit Sub
    With oTalkComputer
        .Rate = lVelocity
        .Speak sText
    End With
    Set oTalkComputer = Nothing
End Sub

    Call Computer_Talk("hello psyke1") ' Velocidad predeterminada 0

    Call Computer_Talk("hello psyke1", 5) ' Más rapido(valor maximo 10)

    Call Computer_Talk("hello psyke1", -7) ' Más lento (valor minimo -10)

Private Sub Aleatory_Comb(ByRef CharList() As String, ByVal iDigits As Integer, ByVal iNumber As Long)
    Dim sWord As String
    Dim x     As Long
    Dim y     As Long
    For y = 1 To iNumber
        For x = 1 To iDigits
            Randomize
            sWord = sWord + CharList((Rnd * (UBound(CharList()) - 1) + 1))
        Next
        MsgBox sWord: sWord = ""
    Next
End Sub
 
Private Sub Form_Load()
    Dim Matriz() As String
    Matriz = Split("a,b,c,d,e,f,g,h,i,j,k,l,,m,ñ,o,p,q,r,s,t,u,v,w,x,y,z", ",")
    Call Aleatory_Comb(Matriz, 5, 7)
End Sub

Option Explicit
 
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Any, ByVal lParam As Long) As Long
 
Private Sub Form_Load()
    Timer1.Interval = 1500: Text1 = "HOla amigosssss"
End Sub
 
Private Sub Timer1_Timer()
    Call SendMessage(Text1.hwnd, &H102, vbKeyLeft, 0&)
End Sub

' ////////////////////////////////////////////////////////////////
' // *Autor: *PsYkE1* (miguelin.majo@gmail.com)                 //
' // *Podeis agrandar o reducir el codigo, siempre y cuando se  //
' // respete la autoria y se me comuniquen esos cambios.        //
' // *Visita http://foro.rthacker.net                           //
' ////////////////////////////////////////////////////////////////
 
Option Explicit
 
Private Declare Function IsCharAlphaNumeric Lib "user32" Alias "IsCharAlphaNumericA" (ByVal cChar As Byte) As Long
 
Public Function Clean_Html_Code(ByVal sHtmlCode As String) As String
    Const ValidSymbolChars             As String = ",.?¿!¡=+-*Ç""_:%$·/|\ºª@ "
    Const StartInvalidString           As String = "<{[(&"
    Const StopInvalidString            As String = ">}];"
    Dim sActualChar                    As String * 1
    Dim bIgnoreString                  As Boolean
    Dim lTotalChar                     As Long
    Dim x                              As Long
    Dim y                              As Long
 
    lTotalChar = Len(sHtmlCode)
    If lTotalChar > 0 Then
        For x = 1 To lTotalChar
            sActualChar = Mid$(sHtmlCode, x, 1)
            If InStr(StartInvalidString, sActualChar) <> 0 Then bIgnoreString = True
            If bIgnoreString = False Then
                If IsCharAlphaNumeric(Asc(sActualChar)) Or InStr(ValidSymbolChars, sActualChar) <> 0 Then
                    Clean_Html_Code = Clean_Html_Code & sActualChar
                End If
            End If
            If InStr(StopInvalidString, sActualChar) <> 0 Then bIgnoreString = False
        Next
        Do Until InStr(1, Clean_Html_Code, "  ") = 0
            Clean_Html_Code = Replace$(Clean_Html_Code, "  ", " ")
            DoEvents
        Loop
    End If
End Function

sData = Clean_Html_Code(sData)

• ¿Que hace?
  Busca palabras similares en una cadena de texto, obtendrias un resultado similar al tipico de Google : "Quizas quiso decir... "
• ¿Como funciona?
  Lo que hace es alamcenar en un array todas las palabras que encuentre en la cadena a analizar, una vez aqui, descompongo la palabra que se busca en las partes correspondientes a el número de coincidencias que queramos buscar, os voy a poner un ejemplo:
  Supongamos que se desea buscar la palabra "mañana", y indicamos a la funcion que busque palabras similares con 3 coincidencias, entonces se partiria la palabra a buscar de esta manera:
  

(x - n) + 1

• Bueno aqui os dejo el codigo:

'==================================================================================================
' º Function  : Check_Similar_Words
' º Version   : 1.2
' º Author    : Mr.Frog ©
' º Country   : Spain
' º Mail      : vbpsyke1@mixmail.com
' º Twitter   : http://twitter.com/#!/PsYkE1
' º Recommended Websites :
'       http://visual-coders.com.ar
'       http://InfrAngeluX.Sytes.Net
'==================================================================================================
 
Option Explicit
Option Base 0
 
Private Declare Function lstrcmpi Lib "kernel32" Alias "lstrcmpiA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
 
Public Function Check_Similar_Words(ByVal sStringToAnalyze As String, ByVal sWord As String, ByVal bvComparationLevel As Byte) As Collection
Const sNullChars                                                            As String = ".,"
Dim cTemp                                                                   As New Collection
Dim sCompareWord()                                                          As String
Dim sTextWord()                                                             As String
Dim sActualWord                                                             As String
Dim lTotalCompWords                                                         As Long
Dim lTotalWords                                                             As Long
Dim lLenWord                                                                As Long
Dim Q                                                                       As Long
Dim G                                                                       As Long
 
    If CBool(bvComparationLevel) Then
        lLenWord = Len(sWord)
        If (lLenWord > 2) And (Len(sStringToAnalyze) > lLenWord) Then
            If (bvComparationLevel < lLenWord) Then
                If Not (InStrB(sWord, vbNewLine)) Then
                    G = 1
 
                    lTotalCompWords = (lLenWord - bvComparationLevel) + 1
                    ReDim sCompareWord(lTotalCompWords) As String
 
                    Do Until Q = lTotalCompWords
                        sCompareWord$(Q) = Mid$(sWord, G, bvComparationLevel)
                        G = G + 1
                        Q = Q + 1
                    Loop
 
                    sStringToAnalyze = Replace$(sStringToAnalyze, vbNewLine, Space$(1))
                    sTextWord() = Split(sStringToAnalyze, Space$(1))
 
                    lTotalWords = UBound(sTextWord)
                    lTotalCompWords = lTotalCompWords - 1
 
                    For Q = 0 To lTotalWords
                        sActualWord = sTextWord(Q)
                        If Len(sActualWord) >= bvComparationLevel Then
                            For G = 0 To lTotalCompWords
                               If CBool(lstrcmpi(sWord, sActualWord)) Then
                                    If InStrB(1, sActualWord, sCompareWord(G), vbTextCompare) Then
                                        If InStrB(sNullChars$, Right$(sActualWord, 1)) Then
                                            sActualWord = Left$(sActualWord, Len(sActualWord) - 1)
                                        End If
                                        On Error Resume Next
                                        cTemp.Add sActualWord, sActualWord
                                    End If
                                End If
                            Next G
                        End If
                    Next Q
 
                    Set Check_Similar_Words = cTemp
                End If
            End If
        End If
    End If
End Function

• Un ejemplo práctico:
  
  Tengo en un TextBox(llamado Text1) esto:
  
  Citar
  La inspiración de Cervantes para componer esta obra vino, al parecer, del llamado Entremés de los romances, que era de fecha anterior (aunque esto es discutido). Su argumento ridiculiza a un labrador que enloquece creyéndose héroe de romances. El labrador abandonó a su mujer, y se echó a los caminos, como hizo Don Quijote. Este entremés posee una doble lectura: también es una crítica a Lope de Vega; quien, después de haber compuesto numerosos romances autobiográficos en los que contaba sus amores, abandonó a su mujer y marchó a la Armada Invencible. Es conocido el interés de Cervantes por el Romancero y su resentimiento por haber sido echado de los teatros por el mayor éxito de Lope de Vega, así como su carácter de gran entremesista. Un argumento a favor de esta hipótesis sería el hecho de que, a pesar de que el narrador nos dice que Don Quijote ha enloquecido a causa de la lectura de libros de caballerías, durante su primera salida recita romances constantemente, sobre todo en los momentos de mayor desvarío. Por todo ello, podría ser una hipótesis verosímil. A este influjo se agregó el de Tirante el Blanco de Joanot Martorell, el del Morgante de Luigi Pulci y el del Orlando Furioso de Ludovico Ariosto.
  
  Para ver un ejemplo:
  

Private Sub Form_Load()
    Dim vItem         As Variant
 
    Debug.Print "--------------->"; Time$
    For Each vItem In Check_Similar_Words(Text1.Text, "argumento", 4)
        Debug.Print vItem
    Next vItem
End Sub

' ////////////////////////////////////////////////////////////////
' // *Autor: *PsYkE1* (miguelin.majo@gmail.com)                 //
' // *Podeis agrandar o reducir el codigo, siempre y cuando se  //
' // respete la autoria y se me comuniquen esos cambios.        //
' // *Agradecimientos a BlackZeroX & Cobein                     //
' // *Visita http://foro.rthacker.net                           //
' ////////////////////////////////////////////////////////////////
Option Explicit
Public Function Text_Between_Words(ByVal sTextToAnalyze As String, ByVal sStartWord As String, ByVal sEndWord As String) As String
    Dim iPosition1             As Integer
    Dim iPosition2             As Integer
    Dim iStart                 As Integer
 
    iPosition1 = InStr(sTextToAnalyze, sStartWord)
    If iPosition1 <> 0 Then
        iStart = iPosition1 + Len(sStartWord)
        iPosition2 = InStr(iStart, sTextToAnalyze, sEndWord)
    Else
        Exit Function
    End If
    If iPosition2 <> 0 Then
        Text_Between_Words = Mid$(sTextToAnalyze, iStart, iPosition2 - iStart)
    End If
End Function

El contexto es el ámbito de referencia de un texto. ¿Qué entiendo por ámbito de referencia?.

    Debug.Print Text_Between_Words(Text1.Text, "referencia", "entiendo")

    Debug.Print Text_Between_Words(Text1.Text, "referencia", "referencia")

Private Sub Form_Load()
    Dim archivo As Integer
    Dim linea   As String
    Dim x       As Integer
    archivo = FreeFile
    Open App.Path & "\lista.txt" For Input As archivo
    Do While Not EOF(archivo)
        Line Input #archivo, linea
        If InStr(linea, "siguiente") <> 0 Then
            Open App.Path & "\" & linea & x & ".txt" For Output As #1
                Print #1, "Hola"
            Close #1
            x = x + 1
        End If
    Loop
End Sub

Option Explicit
 
Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
 
Public Function GET_(hURL As String) As String
    Dim hBuffer As String * 1000
    Dim hInternet As Long
    Dim hFile     As Long
    Dim hRead     As Long
    hInternet = InternetOpen(0, 1, vbNullString, vbNullString, 0): DoEvents
    If hInternet <> 0 Then
        hFile = InternetOpenUrl(hInternet, hURL, vbNullString, ByVal 0&, &H80000000, ByVal 0&): DoEvents
        If hFile <> 0 Then
            Do
                Call InternetReadFile(hFile, hBuffer, 1000, hRead): DoEvents
                GET_ = GET_ & Left$(hBuffer, hRead)
                If hRead = 0 Then Exit Do: DoEvents
            Loop
        End If
    End If
    If hInternet <> 0 Then Call InternetCloseHandle(hInternet)
    If hFile <> 0 Then Call InternetCloseHandle(hFile)
End Function
 
Public Function GetUserName(Optional ID As Long) As String
    Dim Buffer   As String
    Dim UserName As String
    If ID > 0 Then
        MyProfileData = GET_(urlotroperfildemipagina & Str(ID))
    Else
        MyProfileData = GET_(urlmiperfil)
    End If
    'Buscamos "Ver perfil de "
    For x = 1 To Len(MyProfileData)
        Buffer = Mid(MyProfileData, x, 14)
        If Buffer = "Ver perfil de " Then Exit For
    Next
    'Buscamos el nombre
    For x = x + 14 To Len(MyProfileData)
        Buffer = Mid(MyProfileData, x, 1)
        If Buffer <> Chr(34) Then UserName = UserName & Buffer Else Exit For
    Next
    GetUserName = UserName
End Function