Input box accepting only desired format
 

Hi,

I want to include a macro in the following code which the InputBox
accepts SourceFolder name in the MMYYYY format only and no other
format else an error message is displayed. Example, if a folder exist
in C:\ drive by the name "$42007" then an error message be displayed
and macro should run only for "042007"

Here is the entire code in which i want my above criteria to be
included.

Any help would be appreciated.


Private Sub CommandButton1_Click()


Dim MMYYYY

Dim BegDate

Dim SourceFolder

Dim FN As String

Dim Dirname As String

Dim fs As Object



Message = "Please enter the Source folder name in the form MMYYYY as
present under path C:\, for Eg. 082006"


Title = "Date"


BegDate = InputBox(Message, Title)


Application.DisplayAlerts = False


If StrPtr(BegDate) = 0 Then


MsgBox "User hit cancel"


Exit Sub


ElseIf Len(BegDate) = 0 Then


MsgBox "User clicked OK with no input"


Exit Sub


End If



EndDate = Mid(BegDate, 1, 2) & "_" & Mid(BegDate, 3)


Application.DisplayAlerts = False


Set fs = CreateObject("Scripting.FileSystemObject")


Dirname = "C:\" & EndDate


SourceName = "C:\" & BegDate



If Not fs.FolderExists(SourceName) Then


MsgBox "Please enter the valid Source Folder Name"


Exit Sub


End If



If Not fs.FolderExists(Dirname) Then


fs.CreateFolder Dirname

Else


MsgBox "The Destination Folder Already Exist"


Exit Sub


End If


Application.ScreenUpdating = False


FileLocation = "c:\" & BegDate & "\" & "*.xls"




FN = Dir(FileLocation)


If FN = "" Then


MsgBox "No files Found in the Source Folder"


Exit Sub


End If


Do Until FN = ""


If Mid(FN, 4, 1) = "_" And Mid(FN, 5, 2) = Mid(BegDate, 1, 2)
Then


oldname = "C:\" & BegDate & "\" & FN


newname = "C:\" & EndDate & "\" & Mid(FN, 1, 3) & "_" &
Mid(BegDate, 1, 2) & "_" & Mid(BegDate, 3) & ".xls"



FileCopy oldname, newname


Else: MsgBox "Some or All files in the Source folder doesn't
have not a valid monthname. Only the files with valid monthname have
been transferred to destination folder"


Exit Sub


End If

FN = Dir


Loop


Application.ScreenUpdating = True


End Sub



Any help would be appreciated.

Thanks,
Amit

Input box accepting only desired format
 

Why not drop the whole InputBox?FSO stuff and let the user choose a folder:
http://vbnet.mvps.org/code/browse/browsefolders.htm

You can also use the built-in VBA function: Dir ( ), GetAttr, MkDir etc.

NickHK

"Amitriumphs" wrote in message
oups.com...
Hi,

I want to include a macro in the following code which the InputBox
accepts SourceFolder name in the MMYYYY format only and no other
format else an error message is displayed. Example, if a folder exist
in C:\ drive by the name "$42007" then an error message be displayed
and macro should run only for "042007"

Here is the entire code in which i want my above criteria to be
included.

Any help would be appreciated.


Private Sub CommandButton1_Click()


Dim MMYYYY

Dim BegDate

Dim SourceFolder

Dim FN As String

Dim Dirname As String

Dim fs As Object



Message = "Please enter the Source folder name in the form MMYYYY as
present under path C:\, for Eg. 082006"


Title = "Date"


BegDate = InputBox(Message, Title)


Application.DisplayAlerts = False


If StrPtr(BegDate) = 0 Then


MsgBox "User hit cancel"


Exit Sub


ElseIf Len(BegDate) = 0 Then


MsgBox "User clicked OK with no input"


Exit Sub


End If



EndDate = Mid(BegDate, 1, 2) & "_" & Mid(BegDate, 3)


Application.DisplayAlerts = False


Set fs = CreateObject("Scripting.FileSystemObject")


Dirname = "C:\" & EndDate


SourceName = "C:\" & BegDate



If Not fs.FolderExists(SourceName) Then


MsgBox "Please enter the valid Source Folder Name"


Exit Sub


End If



If Not fs.FolderExists(Dirname) Then


fs.CreateFolder Dirname

Else


MsgBox "The Destination Folder Already Exist"


Exit Sub


End If


Application.ScreenUpdating = False


FileLocation = "c:\" & BegDate & "\" & "*.xls"




FN = Dir(FileLocation)


If FN = "" Then


MsgBox "No files Found in the Source Folder"


Exit Sub


End If


Do Until FN = ""


If Mid(FN, 4, 1) = "_" And Mid(FN, 5, 2) = Mid(BegDate, 1, 2)
Then


oldname = "C:\" & BegDate & "\" & FN


newname = "C:\" & EndDate & "\" & Mid(FN, 1, 3) & "_" &
Mid(BegDate, 1, 2) & "_" & Mid(BegDate, 3) & ".xls"



FileCopy oldname, newname


Else: MsgBox "Some or All files in the Source folder doesn't
have not a valid monthname. Only the files with valid monthname have
been transferred to destination folder"


Exit Sub


End If

FN = Dir


Loop


Application.ScreenUpdating = True


End Sub



Any help would be appreciated.

Thanks,
Amit