Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Visual Basic 6 - ciclo alfabetico
Forum - Visual Basic 6 - ciclo alfabetico

Avatar
The Real Dummie (Normal User)
Newbie


Messaggi: 13
Iscritto: 26/10/2009

Segnala al moderatore
Postato alle 12:24
Venerdì, 29/04/2011
eh lo so, lo so... e' un titolo del cavolo, pero' non saprei come porlo diversamente :-(
per prima cosa i miei saluti e poi una domanda:

devo copiare su chiavetta usb dei file ma non so a quale lettera corrisponda la chiavetta. per di piu' potrei avere piu' periferiche inserite e pertanto dovrei copiarlo su tutte. non mi preoccupa poi piu' di tanto se i file venissero copiati anche su i vari dischi fissi presenti sui pc.

la domanda e' questa: esiste un metodo per aprire un ciclo tipo for next che valga per le varie lettere dell'alfabeto? in questo modo io scriverei poche righe per indurre la copiatura su tutte le possibili usb inserite. ovviamente con un bel on error... eviterei di essere interroto per i drive mancanti.

chiedo scusa per il linguaggio poco tecnico, ma dummie ero e dummie saro' a vita :-(((

un bel saluto a tutti ma soprattutto grazie
TRD

PM
Avatar
Sal47 (Normal User)
Pro


Messaggi: 96
Iscritto: 05/02/2009

Up
3
Down
V
Segnala al moderatore
Postato alle 15:56
Venerdì, 29/04/2011
Ciao, forse potrebbe esserti utile il listato seguente che io utilizzo per una esigenza analoga alla tua
(nel mio caso copio il file Form1.jpg dal desktop alla chiavetta USB che nel mio PC ha la lettera H,
e con il ciclo for...next che ho aggiunto funziona per tutte le periferiche, da C a P ad esempio):
________________________________
Option Explicit

Private Sub Command1_Click()
On Error Resume Next
    Dim chiavetta, n
   ' * * ricavato da "I Trucchi di VB6, F. Balena")  
    Dim fs, dc
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dc = fs.Drives
   ' * *
For n = 67 To 80 ' codice ASCII dalla lettera C alla lettera P
    chiavetta = Chr$(n)
    ' per copiare una cartella con tutti i files in essa contenuti
     'fs.CopyFolder "c:\...", "chiavetta:\", True
    ' e per copiare singoli file (True:> sovrascrive il file nel caso esistesse già)
    fs.CopyFile "C:\...\Desktop\Form1.jpg", chiavetta & ":\", True
Next n

End Sub
____________________
Fammi sapere se il listato risolve il problema. Saluti

centro al primo colpo :-))) - The Real Dummie - 29/04/11 18:56
e ovviamente grazie ;-))) - The Real Dummie - 29/04/11 18:59
PM
Avatar
fusebyte (Normal User)
Expert


Messaggi: 332
Iscritto: 24/12/2008

Up
0
Down
V
Segnala al moderatore
Postato alle 15:39
Venerdì, 29/04/2011
Mi intrometto,..tanto fra dummies..:-)
Non sarebbe meglio riuscire a trovare la precisa lettera del drive giusto?

Ciao

sicuramente, questa sarebbe la scelta migliore se avessi situazioni standard sui diversi pc su cui devo lavorare (il programma mi serve per ottimizzare parte del mio lavoro) pero' trattandosi di 5 computer diversi devo fare la cosa piu' standard possibile. grazie mille, in ogni caso :-) - The Real Dummie - 29/04/11 19:01
PM
Avatar
PcBase (Normal User)
Newbie


Messaggi: 20
Iscritto: 19/04/2011

Up
0
Down
V
Segnala al moderatore
Postato alle 12:29
Sabato, 30/04/2011
Ciao

Provate col seguente codice a trovare la lettera della chiave USB:
Attenzione! occorre impostare il riferimento

' requires a reference to the Microsoft Scripting Runtime library:
' Tools, References, Microsoft Scripting Runtime  C:\WINDOWS\system32\Scrrun.dll

Codice sorgente - presumibilmente VB.NET

  1. Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
  2.  
  3. Dim volName As String
  4. Dim VolSerialNumber As Variant 'Long
  5. Dim VolMaxName As Long
  6. Dim VolFlag As Long
  7. Dim VolSysName As String
  8. Public Drive As Variant
  9.  
  10.  
  11. Sub ListAllDrives()
  12. ' requires a reference to the Microsoft Scripting Runtime library:
  13. ' Tools, References, Microsoft Scripting Runtime  C:\WINDOWS\system32\Scrrun.dll
  14. Const StartRow As Long = 1
  15. Dim fso As Scripting.FileSystemObject, drv As Scripting.Drive, r As Long, c As Long
  16.     Set fso = New Scripting.FileSystemObject
  17.     ' list drives
  18.     For Each drv In fso.Drives
  19.         With drv
  20.             If .DriveType = Removable Then
  21.                 If .DriveLetter = "A" Then
  22.                 ElseIf .DriveLetter = "B" Then
  23.                 Else
  24.                     r = r + 1
  25.                     If .IsReady Then
  26.                         If .TotalSize >= 4194304 Then
  27.                             Testo = Testo & .DriveLetter & Chr(13) & Format(.TotalSize / 1048576, "##,##0") & " Mb" & Chr(13) & _
  28.                             Format(.FreeSpace / 1048576, "##,##0") & " Mb" & Chr(13) & _
  29.                             Format((.TotalSize - .FreeSpace) / 1048576, "##,##0") & " Mb" & Chr(13)
  30.                         Else
  31.                             Testo = Testo & .DriveLetter & Chr(13) & Format(.TotalSize / 1024, "##,##0") & " Kb" & Chr(13) & _
  32.                             Format(.FreeSpace / 1024, "##,##0") & " Kb" & Chr(13) & _
  33.                             Format((.TotalSize - .FreeSpace) / 1024, "##,##0") & " Mb" & Chr(13)
  34.                         End If
  35.                         Testo = Testo & .FileSystem & Chr(13)
  36.                     End If
  37.                     VolSerialNumber = 0
  38.                     GetVolumeInformation (.DriveLetter & ":\"), String$(200, 0), Len(String$(200, 0)), VolSerialNumber, VolMaxName, VolFlag, String$(200, 0), Len(String$(200, 0))
  39.                     If Not VolSerialNumber = 0 Then
  40.                         Testo = Testo & VolSerialNumber & Chr(13) & Chr(13)
  41.                     End If
  42.                 End If
  43.             End If
  44.         End With
  45.     Next drv
  46.     Set drv = Nothing
  47.     Set fso = Nothing
  48.     MsgBox Testo
  49. End Sub


Ultima modifica effettuata da PcBase il 30/04/2011 alle 13:44
PM