Jump to content

logroastur

Members
  • Content Count

    2,675
  • Joined

  • Last visited

  • Days Won

    25

Everything posted by logroastur

  1. Puedes realizar 1 – Comprobar el certificado SSL de la página Hemos comprobado que realizar esta operación manualmente es una tarea ardua y que nos hace perder mucho el tiempo. Por este motivo hemos optado por usar una herramienta de verificación SSL con la que nos ahorramos tan engorrosa tarea. Para este caso nos decantamos por la siguiente dirección: https://www.ssllabs.com/ssltest/analyze.html Una vez en ella solo debes poner el nombre de la web donde pone «Hotsname» y pulsar el botón «Submit«. Tras unos minutos, nos dará el resultado del análisis. Comprueba que el nombre del certificado concuerda. 2 – Desactivar el protocolo QUIC en Chrome La siguiente solución pasa por desactivar el protocolo QUIC de Google Chrome. Para ello debes realizar estos simples pasos: Abre el navegador Chrome y escribe en el buscador «chrome://flags/«. Pon la opción «Desactivado«. Reiniciar pulsando en el botón reiniciar. 3 – Borrar estado SSL En esta solución vamos a borrar la configuración SSL del navegador. Es bastante sencillo de realizar y consiste en seguir los siguientes pasos. Ve a «Panel de control«, «Redes e Internet» y clickea en «Opciones de Internet«. Clickea en la pestaña «Contenido» y «Borrar estado SSL«, se encuentra debajo de certificados. Este método permite borrar las SSL de todos los navegadores (Firefox, Apache, Chrome, Explorer, Opera, etc). 4 – Desactivar Antivirus En ocasiones el problema se debe a que nuestro antivirus esta bloqueando nuestra navegación y mandándonos este error. Esto es más general en antivirales de gran potencia y que están actualizados. Para reparar esta causa deberemos desactivar, al menos momentáneamente, el antivirus y comprobar si se ha reparado
  2. Buenas @Lázaro Chequea archivo Un saludo Resumen Coincidencias.rar
  3. Buenas @CBAEZ Puedes chequea el Tema (extraer-impuestos-de-un-xml-de-factura-electronica) en el se encuentra el archivo (GetValuesCFDI) que realiza lo que solicitas Un saludo
  4. Buenas @JSDJSD Puedes usar Private Sub UserForm_Initialize() Dim hoja As Worksheet Dim u As Long Dim datos() Dim i As Long u = Worksheets.Count ReDim datos(1 To u) For Each hoja In Sheets i = i + 1 datos(i) = hoja.Name Next OrdenarLista datos End Sub Private Sub OrdenarLista(Vector As Variant) Dim iMin As Long Dim iMax As Long Dim Vectemp As String Dim Pos As Long Dim i As Long iMin = LBound(Vector) iMax = UBound(Vector) While iMax > iMin Pos = iMin For i = iMin To iMax - 1 If Vector(i) > Vector(i + 1) Then Vectemp = Vector(i + 1) Vector(i + 1) = Vector(i) Vector(i) = Vectemp Pos = i End If Next i iMax = Pos Wend ListBox1.List() = Vector End Sub Un saludo
  5. Buenas @Berlin Puedes usar En celda B3, coloca esta formula =SI(ESNUMERO(B3);CONCATENAR(SI(CONTAR.SI($K$5:$K$18;B3);"FESTIVO";"");SI(Y(DIASEM(B3;2)>5;CONTAR.SI($K$5:$K$18;B3));" y ";"");SI(DIASEM(B3;2)>5;MAYUSC(TEXTO(B3;"dddd"));""));"") y luego expande en las celdas necesitadas En formato condicional Selecciona las celdas A3:B33 y coloca las siguientes formulas Festivos: =Y(ESNUMERO($B3);CONTAR.SI($K$5:$K$18;$B3)) Sábados =Y(ESNUMERO($B3);DIASEM($B3;2)=6;CONTAR.SI($K$5:$K$18;$B3)=0) Domingos =Y(ESNUMERO($B3);DIASEM($B3;2)=7;CONTAR.SI($K$5:$K$18;$B3)=0) Un saludo
  6. Buenas @Luis Perez Puedes chequear Tema (extraer-impuestos-de-un-xml-de-factura-electronica) archivo (GetValuesCFDI) Un saludo
  7. Buenas @Mauri135 O puedes usar Para solo el valor Sub GetCurrenciesEUR_USD() Dim strUR As String Dim strDV As String Dim strTP As String Dim obj As Object Dim objDoc As Object Dim objDV As Object Dim objSP As Object Dim objTP As Object Dim dato As String Dim strERR As String strDV = "top bold inlineblock" strUR = "https://www.investing.com/currencies/eur-usd-historical-data" Set obj = CreateObject("WinHttp.winHttpRequest.5.1") With obj .Open "GET", strUR, False .Option(0) = 13056 .Option(12) = "http-user-agent=Mozilla/5.0 (Windows NT 10.0; WOW64; rv:48.0) Gecko/20100101 Firefox/48.0" .Send If .Status = 200 Then Set objDoc = CreateObject("htmlfile") objDoc.Write .responseText Else strERR = .statustext End If End With Set obj = Nothing If Not objDoc Is Nothing Then Set objDV = objDoc.getElementsByTagName("div") If Not objDV Is Nothing Then For Each objTP In objDV strTP = "" On Error Resume Next strTP = objTP.className On Error GoTo 0 If strTP = strDV Then dato = objTP.innertext Exit For End If Next Else strERR = "No se puede tener acceso" End If Set objDV = Nothing Else strERR = "No se puede tener acceso" End If Set objDoc = Nothing If strERR = "" Then MsgBox dato, vbInformation, Application.OrganizationName Else MsgBox strERR, vbExclamation, Application.OrganizationName End If End Sub O para todos los datos Sub GetTableCurrenciesEUR_USD() Dim strUR As String Dim strDV As String Dim strTP As String Dim obj As Object Dim objDoc As Object Dim objTB As Object Dim objTP As Object Dim objTH As Object Dim objTR As Object Dim objTD As Object Dim dato As String Dim datos() Dim c As Long Dim i As Long Dim n As Long Dim u As Long Dim ii As Long Dim strERR As String strTP = "curr_table" strUR = "https://www.investing.com/currencies/eur-usd-historical-data" Set obj = CreateObject("WinHttp.winHttpRequest.5.1") With obj .Open "GET", strUR, False .Option(0) = 13056 .Option(12) = "http-user-agent=Mozilla/5.0 (Windows NT 10.0; WOW64; rv:48.0) Gecko/20100101 Firefox/48.0" .Send If .Status = 200 Then Set objDoc = CreateObject("htmlfile") objDoc.Write .responseText Else strERR = .statustext End If End With Set obj = Nothing If Not objDoc Is Nothing Then Set objTB = objDoc.getElementById(strTP) If Not objTB Is Nothing Then u = objTB.Rows.Length c = objTB.Rows(1).Cells.Length ReDim datos(1 To u, 1 To c) For Each objTR In objTB.Rows i = i + 1 ii = 0 For Each objTH In objTR.Cells ii = ii + 1 dato = objTH.outerText datos(i, ii) = dato Next Next Else strERR = "No se puede tener acceso" End If Set objTB = Nothing Else strERR = "No se puede tener acceso" End If Set objDoc = Nothing If strERR = "" Then Hoja1.Range("B3").Resize(u, c).Value = datos MsgBox "Finalizada la extración", vbInformation, Application.OrganizationName Else MsgBox strERR, vbExclamation, Application.OrganizationName End If End Sub Un saludo
  8. Buenas @jmadridporto2025 Para una combinación simple, usa Sub GetAllCombis() Dim c As Long Dim i1 As Long Dim i2 As Long Dim i3 As Long Dim i4 As Long Dim n As Long Dim s As Long Dim u As Long Dim v() u = 16 ' Número de Partidos c = ((u * 2) * u) ' Número de combinaciones n = ((u * 2) * u) + (u * 2) ' Nùmero de combinaciones con titulos ReDim v(1 To n, 1 To 3) For i1 = 2 To 3 For i2 = 1 To u s = s + 1 ' Se crea el tiulo de columna v(s, 1) = "Partido" v(s, 2) = "Alta" v(s, 3) = "Baja" For i3 = 1 To i2 s = s + 1 v(s, 1) = Hoja1.Range("A" & i3 + 1).Value v(s, i1) = "x" Next If i2 < u Then For i4 = i2 + 1 To u s = s + 1 v(s, 1) = Hoja1.Range("A" & i4 + 1).Value v(s, IIf(i1 = 2, 3, 2)) = "x" Next End If Next Next Hoja2.Range("A2").Resize(s, 3).Value = v MsgBox "Se crearon " & c & " combinaciones", vbInformation, Application.OrganizationName End Sub Un saludo
  9. Buenas @marroco312 Aunque el compañero @Riddle ya te dio una solución y no la he visto aún Chequea esta otra posible, espero no sea la misma Un saludo Filtro.rar
  10. Buenas @German Veamos con la escasa información que muestras, es materialmente imposible que te pueda dar una posible solución. La información que se debe de saber es la siguiente 1º ver el valor del objeto wbb 2º comprobar que se cargo correctamente la pagina Para ello 1º cambiar el tamaño del wbb para que se vea 2º en el error verifica los valores de wbb en la ventana de VBA en Ventana Locales, en ella comprueba los valores de wbb.document Bien con dicha información podrás saber el por que no funciona Un saludo
  11. Buenas @German Chequea archivo Get TGSS - Web | Logroastur Software Modo descarcarga Un saludo
  12. Buenas Video ejemplo Descargar con Links Publicidad Archivo directo Un saludo
  13. Buenas @Cacho R Sin ganas de perder el tiempo en "discusiones de peces", cosa aparte de que no inicie la "discusión", solo te indico que antes de "lanzar" (y lo dejo entrecomillas) un comentario de que es un posible virus, te reitero que lo lógico es que se medio verifique dentro de posible, por una sencilla razón, lo que se lanza en las redes(y al fin y acabo estos es una red) la mitad de la gente se lo toma al pie de la letra sin contrastar, "a si salen el noventa de los bulos que existen en internet". al menos eso me parece. Bien en cuanto a subir el archivo al servidor del foro, es un punto aparte, y por el momento solo lo realizo cuando los archivos son totalmente creados por mi y si se visualiza el gif se vera que no hay problema alguno para realizar la descarga. Bien como lo que estamos quitar importancia a la consulta, lo dicho por mi parte cierro el punto de la "discusión" puesto lo que importa es la consula Un saludo
  14. Buenas @Cacho R Y para terminar los links de descarga tampoco poseen virus alguno Reporte Link Consulta Link 1 Link Reporte Link Reporte virustotal Consulta Link1 Captura de pantalla Reporte Reporte virustotal - Link2 Link Reporte virus Consulta Link2 Captura de pantalla Bien lo dicho anteriormente, espero tus( @Cacho R ) comentarios Un saludo
  15. Buenas @Cacho R Siento indicarte que no es correcto, el archivo no posee ningún virus, ni cosa rara Reportes de https://www.virustotal.com/ Del archivo Zip Link para ver el reporte completo Reporte virustotal - Consulta.zip Captura de pantalla Reporte del excel Link para ver el reporte completo Reporte virustotal - Consulta.xls Captura de pantalla Bien @Cacho R como ves no es correcto, y como comentario antes de dar algo como real se debe de verificar, pues aunque no lo parezca el comentario que realizaste escomo si yo deseo que se infecte algún usuario y esto no es verdad por lo que solicito que rectifiques tu comentario Un saludo
  16. Buenas @CarlosKurt Chequea archivo Extraer información Web Para realizar la descarga chequea gif Gif Proceso Descarga Un saludo
  17. Buenas @pedrot Veamos Funcione FileAlreadyOpen 1º debe de recibir el fullname del archivo a verificar si esta abierto, es decir se le debe de enviar la ubicación del archivo, es decir la carpetas, el nombre del archivo y la extensión que posee el archivo. Por ejemplo Dim bolEsta As Boolean bolEsta = FileAlreadyOpen("C:\Carpeta\Archivo.xls") 2º Para realizar la apertura de un archivo, si no esta ubicado en la misma carpeta del archivo que realiza la apertura se le debe de dar el fullname del archivo a verificar si esta abierto, es decir se le debe de enviar la ubicación del archivo, es decir la carpetas, el nombre del archivo y la extensión que posee el archivo Por ejemplo si es un excel Workbooks.Open "C:\Carpeta\Archivo.xls" Si el archivo a abrir no excel ThisWorkbook.FollowHyperlink "C:\Carpeta\Archivo.pdf" Un saludo PD: como recomendación es que ejecutes los códigos que ofreci en el ejemplo anterior en formato de interrupción es decir con F5 para ir viendo que es lo que se realiza y los valores que toman las variables que usan
  18. buenas @pedrot prueba Private Function FileAlreadyOpen(nomb_archivo As String) As Boolean Dim f As Integer Dim elerror As Long Dim strError As String f = FreeFile On Error Resume Next Open nomb_archivo For Binary Access Read Write Lock Read Write As #f Close #f elerror = Err.Number strError = Err.Description On Error GoTo 0 If elerror <> 0 Then FileAlreadyOpen = True MsgBox "Error #" & Str(elerror) & " – " & strError End If End Function ' Sub Busca_archivo() Dim nomb_archivo As String Dim file_buscado As String Dim ruta As String Dim vFils As Object Dim tFile As String Dim fFile As String nomb_archivo = Range("ArchivoBase") If Dir(nomb_archivo, vbArchive) <> "" Then file_buscado = nomb_archivo Else ruta = ThisWorkbook.Path With CreateObject("Scripting.FileSystemObject").GetFolder(ruta) For Each vFils In .ParentFolder.Files fFile = vFils.Path: tFile = vFils.Name If tFile = nomb_archivo & ".xlsx" Or _ tFile = nomb_archivo & ".xls" Or _ tFile = nomb_archivo & ".xlsm" Or _ tFile = nomb_archivo Or _ fFile = nomb_archivo Then file_buscado = fFile Exit For End If Next End With End If If file_buscado = "" Then MsgBox "El archivo " & nomb_buscado & " no esta en las carpetas", vbCritical, Application.OrganizationName Else If FileAlreadyOpen(file_buscado) Then MsgBox "Archivo " & nomb_archivo & " Abierto", vbOKOnly + vbInformation Else Workbooks.Open file_buscado End If End If End Sub Un saludo
  19. Buenas @CarlosKurt Veamos es que los valores que muestras no son correctos Veamos si me explico 1º debes de abrir la pagina web y luego sobre ella botón derecho y seleccionar ver y se abrirá el código fuente de ella por ejemplo en tu navegador inserta view-source:https://www.universidadperu.com/empresas/radio-panamericana.php 2º buscas en ella el RUC que se encorar en Bien encontrado veras que la información esta a) en un li al no poseer ni class, name y id se debe de indicar la posición dentro del que lo tiene por lo que será li(0) el li esta incluido en ul al no poseer ni class, name y id se debe de indicar la posición dentro del que lo tiene por lo que será sera ul(0) c) el ul esta incuido en div al no poseer ni class, name y id se debe de indicar la posición dentro del que lo tiene por lo que se busca objetos que no esten cerrados d) bien la linea anterior posee en ella hay div, ins y script. pero todos están cerrados, pues poseen la linea </ y nombre del objeto por lo que se debe de subir a la siguiente linea la cual también esta cerrado el objeto. seguimos subiendo Bien esta todos los objetos estan cerrados, seguimos subiendo Bien en esta linea si hay objetos abiertos y no cerrados, es decir le objeto es el que posee los objetos que poseen los datos, y como si posee id lo que se debe de usar es middlecolumnhome y para seleccionar el div que posee ul sera div(1) puesto que es el segundo recuerda que entre el de la linea que posee middlecolumnhome y div que posee ul hay dos divs y como el contador se inicia en cero sera 1 en resumas el código para seleccionar los datos se deberá de usar Bien espero que te sea de utilidad Un saludo
  20. Buenas @CarlosKurt Veamos lo que debes de realizar es analizar el código fuente de la pagina web, para obtener los names, classname o los ids de los objetos que contienen la información y luego usar WINHTTP.WinHTTPRequest.5.1 para obtener la pagina web y HTMLFile para obtener los objetos y extraer la información. Por ejemplo para sacar la dirección de Web de la empresa Sub GetAllElementsWeb() Dim sUr As String Dim doc As Object Dim div As Object Dim sElm As String sUr = "https://www.universidadperu.com/empresas/busqueda/20333266025" Set doc = myConnection(sUr) Set div = doc.getElementById("middlecolumnhome") sElm = GetValuesDivsInfo(div) MsgBox sElm End Sub Private Function myConnection(strUr As String) As Object Dim oHtml As Object Set oHtml = CreateObject("HTMLFile") With CreateObject("WINHTTP.WinHTTPRequest.5.1") .Open "GET", strUr, False .send oHtml.write (.responseText) End With Set myConnection = oHtml End Function Private Function GetValuesDivsInfo(oHtml As Object) As String Dim lis As Object Set lis = oHtml.getElementsByTagName("div")(1).getElementsByTagName("ul")(0).getElementsByTagName("li")(2).getElementsByTagName("a") GetValuesDivsInfo = lis(0).innerText End Function Bien lo dicho primero lee el código fuente de la pagina web para ver quien contiene los datos. Por otra parte te comento sobre la consulta Extraer información web con captcha Si se puede realizar, al menos yo lo realice pero usando vbNet y/o C#, incluso ya realice uno para la propia pagina que comentas aduanet Un saludo
  21. Buenas @Lázaro Chequea archivo GetSorteos OnceWeb En el archivo posee dos tablas para colocar los datos, en la primera sería para colocar lo seleccionado indicando el mes y año y en la segunda sería para colocar todo el historial En la primera hoja posees los dos botones para ejecutar la extración Según mis pruebas para traer el historial completo el tiempo era de unos 3 minutos pero depende de la conexión que poseas Bien ya me indicaras si precisas ajuste o encuentras algún error Un saludo
  22. Buenas @Lázaro Veamos es que el indicador de columna no es correcto Si dejas celdas de separación por ejemplo Y11 = =SI.ERROR(INDICE(GetParesUnicos($S11:$W11);COLUMNA(A$1));"") Z11 = =SI.ERROR(INDICE(GetParesUnicos($S11:$W11);COLUMNA(B$1));"") AB11 = =SI.ERROR(INDICE(GetParesUnicos($S11:$W11);COLUMNA(D$1));"") Bien el indice las celdas Y11 y Z11 si serían correctas, pero en AB11 no puesto que le indicas que el indicador sería 4(COLUMNA(D$1), cuando debería ser 3(COLUMNA(C$1)) Bien o colocas los indicadores manualmente Y11 = =SI.ERROR(INDICE(GetParesUnicos($S11:$W11);1);"") Z11 = =SI.ERROR(INDICE(GetParesUnicos($S11:$W11);2);"") AB11 = =SI.ERROR(INDICE(GetParesUnicos($S11:$W11);3);"") O colocas en Y11 =SI.ERROR(INDICE(GetParesUnicos($S11:$W11);SUMA(CONTAR($X11:X11)+1));"") y luego copias y pegas en el resto de celdas. Claro esta esto funcionara siempre y cuando no tengas celdas numericás intercaladas ni al principio es decir en las celdas de la columna X de cada fila y en columnas AA,AD,AG, etc Un saludo
  23. Buenas @Lázaro Para los negativos puedes usar =SUMAPRODUCTO((AT$12:BQ$12<>"ok")*(AT13:BQ13<0)*1) Para el tema de los pares deberías usar VBA, puesto que la formulación se complicaría (creo yo) en excesivo Puede usar colocar lo siguiente en un modulo estandar Function GetParesUnicos(rngValores As Range) As Variant Dim i As Long Dim j As Long Dim n As Long Dim u As Long Dim s As Long Dim t As String Dim d As String Dim v() Dim d1 As Variant Dim d2 As Variant Dim r As Range On Error Resume Next Set r = rngValores u = r.Columns.Count s = WorksheetFunction.Count(r) If s > 1 Then For i = 1 To u If i < u Then d1 = r(1, i).Value If IsNumeric(d1) And Len(d1) > 0 Then For j = i + 1 To u - 1 d2 = r(1, j).Value If IsNumeric(d2) And Len(d2) > 0 Then d = "|" & d1 & "|" & d2 & "|" If InStr(1, t, d, vbTextCompare) = 0 Then t = t & d n = n + 1 ReDim Preserve v(1 To n) v(n) = d1 n = n + 1 ReDim Preserve v(1 To n) v(n) = d2 End If End If Next End If End If Next ElseIf s = 1 Then d1 = r(1, 1).Value If IsNumeric(d1) And Len(d1) > 0 Then ReDim Preserve v(1 To 1) v(1) = d1 End If End If Set r = Nothing GetParesUnicos = v End Function y el uso sería =SI.ERROR(INDICE(GetParesUnicos($S13:$W13);COLUMNA(A$1));"") Un saludo
  24. Buenas @Visor Chequea archivo Un saludo Registrar asistencia.zip
  25. No lo es Para realizar la descarga Seguir las indicaciones en el gif Gif Proceso Descarga Un saludo
×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png