Continuación de la pregunta del IP
Hola Experto,
Nuevamente te busco, para seguir con lo de la macro.
1. Seria bueno investigar como se puede hacer con la IP.
2. Mientras tanto perfeccionemos la macro que es esta basado en la que me diste:
Private Sub Control_serial()
Dim tipodrive As String, serial As String
Dim fs, d, s, t, f, x, drvpath
drvpath = "C"
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))
Set Hojaserial = Sheets("serial")
Select Case d.DriveType
Case 0: t = "Desconocido"
Case 1: t = "Separable"
Case 2: t = "Fijo"
Case 3: t = "Red"
Case 4: t = "CD-ROM"
Case 5: t = "Disco RAM "
End Select
f = "Unidad " & d.DriveLetter & ": - " & t
s = d.SerialNumber
Hojaserial.Select
If Range("C2").Value = "" Then
tipodrive = "A2"
serial = "B2"
Hojaserial.Select
Range(tipodrive).Value = f
Range(serial).Value = s
Range("C2").Value = 1
Else
tipodrive = "A3"
serial = "B3"
Hojaserial.Select
Range(tipodrive).Value = f
Range(serial).Value = s
If Range(serial).Value <> Range("B2").Value Then
MsgBox "Lo siento, este libro no se puede abrir en este equipo"
ThisWorkbook.Close False
End If
End If
End Sub
Como te comentaba esta reconoce el disco duro a veces si o otras veces no, y como puedes ver cree una Hoja llamada "serial" para guardar el numero serial
Cuando si: Cuando abro el archivo por excel desde Archivo/ Abrir
Cuando no: Cuando abro el archivo desde el explorador de Windows, cuando es así, asume el directorio del ultimo documento abierto en excel. He intentado obviar este error colocando al inicio de la subrutina esto:
Chdir "C:\"
, pero no cambia el directorio.
Igualmente con :
With Application
.AltStartupPaht = "C:\"
End With
Pero tampoco cambia el directorio, sino que sigue cogiendo al directorio que se predetermino.
¿Qué solución puede haber para esto?
Nuevamente te busco, para seguir con lo de la macro.
1. Seria bueno investigar como se puede hacer con la IP.
2. Mientras tanto perfeccionemos la macro que es esta basado en la que me diste:
Private Sub Control_serial()
Dim tipodrive As String, serial As String
Dim fs, d, s, t, f, x, drvpath
drvpath = "C"
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))
Set Hojaserial = Sheets("serial")
Select Case d.DriveType
Case 0: t = "Desconocido"
Case 1: t = "Separable"
Case 2: t = "Fijo"
Case 3: t = "Red"
Case 4: t = "CD-ROM"
Case 5: t = "Disco RAM "
End Select
f = "Unidad " & d.DriveLetter & ": - " & t
s = d.SerialNumber
Hojaserial.Select
If Range("C2").Value = "" Then
tipodrive = "A2"
serial = "B2"
Hojaserial.Select
Range(tipodrive).Value = f
Range(serial).Value = s
Range("C2").Value = 1
Else
tipodrive = "A3"
serial = "B3"
Hojaserial.Select
Range(tipodrive).Value = f
Range(serial).Value = s
If Range(serial).Value <> Range("B2").Value Then
MsgBox "Lo siento, este libro no se puede abrir en este equipo"
ThisWorkbook.Close False
End If
End If
End Sub
Como te comentaba esta reconoce el disco duro a veces si o otras veces no, y como puedes ver cree una Hoja llamada "serial" para guardar el numero serial
Cuando si: Cuando abro el archivo por excel desde Archivo/ Abrir
Cuando no: Cuando abro el archivo desde el explorador de Windows, cuando es así, asume el directorio del ultimo documento abierto en excel. He intentado obviar este error colocando al inicio de la subrutina esto:
Chdir "C:\"
, pero no cambia el directorio.
Igualmente con :
With Application
.AltStartupPaht = "C:\"
End With
Pero tampoco cambia el directorio, sino que sigue cogiendo al directorio que se predetermino.
¿Qué solución puede haber para esto?
1 Respuesta
Respuesta
1