Excel - crear DBF con nombre de hoja

Saludos a tod@s.

Como se asigna el nombre de una hoja a una variable y luego con esta variable crear una dbf de la hoja.

Me explico. Recibo cada mes unos 75 libros los cuales tienen unas 54 hojas c/u. Lo que necesito hacer es migrar el contenido de las hojas a dbs's. Ya intente leer el libro desde mi manejador de dbf pero no se puede. Quiero crear archivos temporales para que se puedan migrar a mi base de datos.

ejemplo:
Quiero migrar de mi libro consumo.xls que contiene la hoja "papel" a hoja.dbf o tambien hoja.xls me funciona de las dos maneras.
Ya use el grabador de macros, por lo que solo me falta el nombre de la hoja y grabar con ese nombre el nuevo archivo.

Pues, usa la opcion "guardar como" que trae excel (excepto la version 2007).

Usando VBA seria asi; pero OJO, solo se garab la hoja activa como *.dbf, asi que, a traves de un FOR EACH, abri que grabar cada hoja:

Dim nombre as string
nombre = Activesheet.Name
ActiveWorkbook.SaveAs Filename:= _
"C:" & nombre & ".dbf", FileFormat:=xlDBF4

Ya lo del FOR EACH te lo dejo a ti. Eso si, si el nombre de alguna hoja tiene caracteres no permitidos para nombres de archivos, pues, tendras errores

Abraham

Gracias Abraham. Es lo que necesita.

Intenté seguir el plan de Abraham y salió esto...

Option Explicit

'//By JuanC - Abr. 2008

Sub Main()
Dim sName$, wbk As Workbook, ws As Worksheet
On Error Resume Next
Set wbk = ActiveWorkbook
For Each ws In wbk.Sheets
With ws
sName = ws.Name
If Is_Valid_File_Name(sName) Then
.Activate
Call Save(sName)
End If
End With
Next
Set wbk = Nothing
Set ws = Nothing
End Sub

Private Function Save(ByVal sFileName As String) As Boolean
ActiveWorkbook.SaveAs Filename:="C:" & sFileName & ".dbf", FileFormat:=xlDBF4
End Function

Private Function Is_Valid_File_Name(ByVal sName As String) As Boolean
Dim aArray() As String
Dim i&, l&, lCount&, s$, lPos&, sTmp$

Is_Valid_File_Name = False

If InStr(1, sName, "") Then
s = Mid(sName, InStrRev(sName, "") + 1)
Else
s = sName
End If
lPos = InStr(1, s, ".")
If lPos <= 0 Then
s = Trim(s)
sTmp = UCase(s)
Else
sTmp = UCase(Trim(Mid(s, 1, lPos - 1)))
If Len(sTmp) = 0 Then Exit Function
End If
If sTmp = "AUX" Or sTmp = "CON" Or sTmp = "PRN" Then Exit Function
l = Len(s)
If l = 0 Then Exit Function
For i = 1 To l
ReDim Preserve aArray(i)
aArray(i) = Mid(s, i, 1)
Next
If aArray(1) = "." Then Exit Function
lCount = UBound(aArray())
For i = 1 To lCount
If Not aArray(i) Like "[!/:*?""<>|]" Then Exit Function
Next
Erase aArray
Is_Valid_File_Name = True
End Function

Saludos desde Baires, JuanC

Bien!!!! Solo una cosa JuanC, yo que tu le voy pasando una factura a nuestro amigo jejejje. Yo solo cobrare 25% por ser el "creativo", como dicen los que estan metidos en publicidad :)

Abraham

PD: Has visto el msj que dice que elimino los "botones" max, min y cerrar del excel, no de un libro... que opinas?

Abraham, encontre la instruccion que me quita los botones en mencion.

Private Sub CommandButton1_Click()
'Quita los botones
Application.CommandBars("Worksheet Menu Bar").Enabled = False
Application.DisplayFullScreen = True
End Sub

Private Sub CommandButton2_Click()
'Restablece los botones
Application.CommandBars("Worksheet Menu Bar").Enabled = True
Application.DisplayFullScreen = False
End Sub

No tengo del todo claro su funcionamiento, pero me restablecio los botones y eso era mi problema.

Me olvidaba. Si "Application.CommandBars("Worksheet Menu Bar").Enabled = True" y "Application.DisplayFullScreen = True" me crea la situacion que consulte.

Private Sub CommandButton2_Click()
Application.CommandBars("Worksheet Menu Bar").Enabled = True
Application.DisplayFullScreen = True
End Sub

Hola JuanC.

Revice el codigo, al principio no me funcionaba. Es que en la instruccion
"If InStr(1, sName, "")" el resultado siempre daba cero. Por lo que modifique el codigo, dejandolo asi "If InStr(1, sName, "") - 1 Then". De esta manera ya me funciono y esta excelente.

Gracias.