Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Private Sub Command1_Click()
'PARA ESCRIBIR EN UN ARCHIVO
on error goto fallo
cd.Filter = "Archivos de texto|*.txt" 'es un filtro que solo puedes coger los txt, si kieres borralo
cd.ShowSave 'muestra la pantalla para elegir el archivo
If cd.FileName = "" Then Exit Sub 'Sino no as seleccionao ninguna se va fuera
Open cd.FileName For Append As #1 'Se abre el archivo
Print #1, Text1 'se escribe lo que ay en el text1
Close #1 'se cierra
exit sub
fallo:
' lo que pongas aquí es lo que ocurre si pulsaron ESC
End Sub
Public Function LeerIni(sección As String, Entrada As String, ArchivoIni As String)
Dim I As Integer
Dim Dato As String
Dato = String$(128, " ")
I = GetPrivateProfileString(sección, Entrada, Directorio, Dato, Len(Dato), ArchivoIni)
LeerIni = IIf(I > 0, Est, "")
End FunctionPublic Function EscribirIni(sección As String, Entrada As String, DatoAEscribir As String, ArchivoIni)
Dim I As Integer
I = WritePrivateProfileString(sección, Entrada, "", , DatoAEscribir, ArchivoIni)
EscribirIni = IIf(I = 1, True, False)
End Function
Public Function ObtenerUsuario() As String
'Esta función devuelve el nombre del Usuario
Dim sBuffer As String
Dim lSize As Long
Dim sUsuario As String
sBuffer = Space$(260)
lSize = Len(sBuffer)
Call GetUserName(sBuffer, lSize)
If lSize > 0 Then
sUsuario = Left$(sBuffer, lSize)
'Quitarle el CHR$(0) del final...
lSize = InStr(sUsuario, Chr$(0))
If lSize Then
sUsuario = Left$(sUsuario, lSize - 1)
End If
Else
sUsuario = ""
End If
ObtenerUsuario = sUsuario
End FunctionPublic Function ObtenerNombreEquipo() As String
Dim sBuffer As String, lSize As Long, Resultado As Long
Const MAX_COMPUTERNAME_LENGTH As Long = 31 'longitud máxima del nombre de un equipo
sBuffer = String(MAX_COMPUTERNAME_LENGTH + 1, vbNullChar)
lSize = MAX_COMPUTERNAME_LENGTH
Resultado = GetComputerName(sBuffer, lSize)
ObtenerNombreEquipo = IIf(Resultado, Left(sBuffer, lSize), "")
End Function Public Function ObtenerSystem() As String
Dim DirectorioSystem As String * 255
Dim CadenaResultante As Long
CadenaResultante = GetSystemDirectory(DirectorioSystem, 255)
ObtenerSystem = Left(DirectorioSystem, CadenaResultante)
End FunctionPublic Function ObtenerTemp() As String
Dim Buffer As String, Size As Long
Const MAX_PATH = 260
' Inicializamos la cadena donde se cargará la trayectoria
Buffer = String(MAX_PATH, 0)
' Recuperamos la trayectoria
Size = GetTempPath(Len(Buffer) - 1, Buffer)
If Size <> 0 Then
GetTempFolder = Left(Buffer, Size)
End If
End Function
Const CSIDL_DESKTOP = &H0
Const CSIDL_PROGRAMS = &H2
Const CSIDL_CONTROLS = &H3
Const CSIDL_PRINTERS = &H4
Const CSIDL_PERSONAL = &H5
Const CSIDL_FAVORITES = &H6
Const CSIDL_STARTUP = &H7
Const CSIDL_RECENT = &H8
Const CSIDL_SENDTO = &H9
Const CSIDL_BITBUCKET = &HA
Const CSIDL_STARTMENU = &HB
Const CSIDL_DESKTOPDIRECTORY = &H10
Const CSIDL_DRIVES = &H11
Const CSIDL_NETWORK = &H12
Const CSIDL_NETHOOD = &H13
Const CSIDL_FONTS = &H14
Const CSIDL_TEMPLATES = &H15
Const MAX_PATH = 260
Public Function ObtenerMenuUsuario() As String
ObtenerMenuUsuario = GetSpecialfolder(CSIDL_STARTMENU)
End Function
Public Function ObtenerFavoritos() As String
ObtenerFavoritos = GetSpecialfolder(CSIDL_FAVORITES)
End Function
Public Function ObtenerMenuProgramas() As String
ObtenerMenuProgramas = GetSpecialfolder(CSIDL_PROGRAMS)
End Function
Public Function ObtenerEscritorio() As String
ObtenerEscritorio = GetSpecialfolder(CSIDL_DESKTOP)
End Function