Astuces Excel
  1. Astuces Excel
  3. Télécharger datatables des hyperliens dans la création de nouveaux dossiers en utilisant vba
Intereting Posts
Quelle est la meilleure façon de créer une documentation d'aide user pour une solution Excel VBA? Données corrompues sur programme close in jxl Formage de colonnes spécifiques à l'aide d'Epplus Not Saving Filtres sur une feuille séparée qui montre des colonnes spécifiques de la table Excel import de données à partir de la feuille Excel en fonction du titre de la colonne Excel VBA Organisation de données avec fractionnement et duplication comment replace la valeur dans une string en fonction de la valeur dans une autre colonne dans excel Enregistrement des noms d'images avec leurs tailles dans un file dans Windows Comment répertorier les propriétés d'un object graphique dans VBA? Excel 2010 – Formule pour extraire des données de classurs externes fermés avec un nom de file généré Python génère une sortie prête pour Excel Exporter des données vers un file excel de l'échec Classique ASP Formule pour get la valeur maximale dans l'ordre alphabétique dans un sous-set d'une gamme Appliquer la valeur de la colonne de date dans une formule VBA (Excel): copy en boucle sur plusieurs critères dans plusieurs feuilles de travail

Télécharger datatables des hyperliens dans la création de nouveaux dossiers en utilisant vba

Image de données en excel Je télécharge des données du net à l'aide d'hyperliens et de mettre des données téléchargées dans des dossiers créés avec les noms répertoriés dans la colonne A.

En ce moment, datatables sont téléchargées avec succès quand il n'y a qu'un seul hyperlink pour un dossier, mais maintenant, je souhaite aussi mettre plus de 2 files dans un même dossier.

Quelqu'un peut-il suggérer un moyen d'améliorer le code pour permettre cela? 

Option Explicit Private Declare Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" (ByVal pCaller As Long, _ ByVal szURL As Ssortingng, ByVal szFileName As Ssortingng, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Dim ret As Long '> This is where the files will be saved. Change as applicable Const FolderName As Ssortingng = "C:\Users\a3rgcw\Downloads\" Sub Download() Dim ws As Worksheet Dim lastRow As Long, i As Long Dim strPath As Ssortingng Set ws = Sheets("Sheet1") lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row For i = 1 To lastRow strPath = FolderName & ws.Range("A" & i).Value & ".zip" ret = URLDownloadToFile(0, ws.Range("D" & i).Value, strPath, 0, 0) If ret = 0 Then ws.Range("F" & i).Value = "PR data successfully downloaded" Else ws.Range("F" & i).Value = "Unable to download PR data" End If Next i End Sub

édité après les clarifications OP il n'a pas d'hyperliens

Selon votre code et votre lien, votre code ne crée pas de nouveaux dossiers, mais il crée de nombreux nouveaux files dans le dossier "C: \ Users \ a3rgcw \ Downloads \" (c'est-à-dire votre variable FolderName

et puisque ces noms de files sont construits avec ws.Range("A" & i).Value & ".zip" , puis pour chaque même valeur dans n'importe quelle colonne Une cellule, elle écrase le file existant avec le nouveau

En outre, votre lien affiche la colonne "C" avec des liens hypertext tandis que votre code les lisent à partir de la colonne "D" ( ws.Range("D" & i).Value

pour éviter l'écrasement de files, vous pouvez définir le nom de zip à partir d'une combinaison de "dossier" (des cellules de la colonne A) et du nom du file (de l'adresse de hyperlink correspondante) comme suit (en supposant que votre hypothèse de code pour colonne de liens est la valide) 

 Sub Download() Dim ws As Worksheet Dim LastRow As Long, i As Long Dim strPath As Ssortingng Set ws = Sheets("Sheet1") LastRow = ws.Range("A" & Rows.Count).End(xlUp).row For i = 1 To LastRow strPath = FolderName & _ ws.Range("A" & i).Value & "-" & _ GetName(ws.Range("D" & i)) & ".zip" ret = URLDownloadToFile(0, ws.Range("D" & i).Value, strPath, 0, 0) If ret = 0 Then ws.Range("F" & i).Value = "PR data successfully downloaded" Else ws.Range("F" & i).Value = "Unable to download PR data" End If Next i End Sub Function GetName(rng As Range) As Ssortingng With rng GetName = Right(.Value, Len(.Value) - InStrRev(.Value, "/")) End With End Function

qui pourrait également être refacturé comme suit: 

 Sub Download() Dim strPath As Ssortingng Dim cell As Range With Sheets("Sheet1") For Each cell In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) strPath = FolderName & _ cell.Value & "-" & _ GetName(cell.Offset(, 3)) & ".zip" ret = URLDownloadToFile(0, cell.Offset(, 3).Value, strPath, 0, 0) cell.Offset(, 5).Value = IIf(ret = 0, "PR data successfully downloaded", "Unable to download PR data") Next End With End Sub Function GetName(rng As Range) As Ssortingng With rng GetName = Right(.Value, Len(.Value) - InStrRev(.Value, "/")) End With End Function