Sección de códigos , trucos y ejemplos para visual basic

199 - Otro ejemplo para extraer direcciones url de un archivo

Este ejemplo me permitío subirlo Samper del foro de canalvisualbasic , y utiliza Fso - FilesystemObject para leer el fichero y luego buscar las url con las funciones de visual basic

vista del ejemplo que lista las direcciones url del archivo seleccionado en el control textBox

Las funciones para buscar las url, que están dentro de las etiquetas a href, lo hace con la función Instr y algunas otras comprobaciones.

Para el ejemplo añadir

la referencia a Microsoft Scrpting RunTime para poder usar FileSystemObject para leer el archivo ( Esto obviamente se podría obviar y leer el archivo con Open ).
También agregar un CommonDialog para seleccionar un fichero
un command1
y un control textBox llamado txtURLs

Código fuente en el formulario:

''''''''''''''''''''''''' ' Referencias: Microsoft Scrpting RunTime Private Sub Extraer_Url_FSO(File_Path As String) 'variables para utilizar FSO-FileSystemObject Dim oFS As FileSystemObject Dim oTS As TextStream Dim n As Long 'Variables para el contenido del fichero y almacenar las url Dim cStream As String, cURL As String Dim nPosI As Long, nPosF As Long 'Crea un nuevo objeto FSO Set oFS = New FileSystemObject 'Abre el archivo indicado en el Path Set oTS = oFS.OpenTextFile(File_Path, ForReading) Me.txtURLs = "" cStream = "" Do While True 'Lee de a porciones de 10 K aprox cStream = cStream & oTS.Read(10240) Do While True 'busca la etiqueta para optener la posición nPosI = InStr(1, LCase(cStream), "<a href=" & Chr(34), vbTextCompare) ''Si no hay sale If nPosI <= 0 Then Exit Do End If 'Busca la comilla a partir del 9, es decir de -> href nPosF = InStr(nPosI + 9, cStream, Chr(34), vbTextCompare) If nPosF <= nPosI + 9 Then Exit Do End If 'Almacena la Url cURL = Mid(cStream, nPosI + 9, nPosF - (nPosI + 9)) 'si contiene el http, https o ftp en la dirección, la agrega If InStr(1, LCase(cURL), "http:") > 0 Or _ InStr(1, LCase(cURL), "https:") > 0 Or _ InStr(1, LCase(cURL), "ftp:") > 0 Then Me.txtURLs = Me.txtURLs & cURL & vbCrLf End If cStream = Mid(cStream, nPosF + 1) n = n + 1 Loop 'si es el final de archivo sale If oTS.AtEndOfStream Then Exit Do End If Loop MsgBox " Direcciones Url encontradas " & n, vbInformation 'cierra el archivo oTS.Close 'Elimina las variables de objeto Set oTS = Nothing Set oFS = Nothing End Sub Private Sub Command1_Click() With CommonDialog1 .DialogTitle = "Seleccionar el archivo para extraer las direcciones URL " .ShowOpen If .FileName = "" Then Exit Sub Call Extraer_Url_FSO(.FileName) End With End Sub Private Sub Form_Load() Me.Caption = "Ejemplo para extraer direcciones de un archivo" Command1.Caption = " Abrir archivo " End Sub</a>

Recursos visual basic - Enlaces relacionados

Expresiones regulares para extraer desde un fichero, todas las direcciones de email

Buscar en Recursos vb