macro to open existing file or create it if it does not exist

hi,
i have a workbook the essentially is supposed to send the data entered into it to the individual users that use it as well as to my file svr. I have been able to get it to save to my file server easy enough because i created one mail folder for all the data to go to. the problem I am having is that each user needs a copy of their own data locally on their pc should our network go down. I cannot seem to write a macro that will search the c:\ for the file "my schedule appointments" and if it it exists open it paste in next empty row their data, or if it does not exist go ahead and create it for them and then paste the data save and close. i can either get it to create the folder or search for it but i cant seem to get the if else to work for me as in if they have it then go ahead open and paste, if they dont create and paste. the create would only be needed for the new employees using it instead of me having to go to each individual station and setting up a new file for it to work. i greatly appreciate any help you can give.

Re: macro to open existing file or create it if it does not exist

I actually used one someone had posted from another site, the problem is, it doesnt have an "if this file doesnt exist create it" code, and i can create them, but then it creates everytime and then i wind up with errors of creating a duplicate file name and overwrite options but i need the data maintained not overwritten.

Sub TransferData()

Dim wkb As Workbook, wks As Worksheet, LastRow As Long
Dim FilePath As String, FileName As String
Dim ws As Worksheet, blnOpened As Boolean
FilePath = "c:\"
FileName = "My Scheduled Appointments".xlsm"
Call ToggleEvents(False)
Set ws = ThisWorkbook.Sheets("Call Center Template")
If WbOpen(FileName) = True Then
Set wkb = Workbooks(FileName)
blnOpened = False
Else
If Right(FilePath, 1) <> Application.PathSeparator Then
FilePath = FilePath & Application.PathSeparator
End If
Set wkb = Workbooks.Open(FilePath & FileName)
blnOpened = True
End If
Set wks = wkb.Sheets("All Data")
LastRow = wks.Cells.Find(what:="*", after:=wks.Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
wks.Cells(LastRow, "A").Value = ws.Cells(19, "B").Value
wks.Cells(LastRow, "B").Value = ws.Cells(100, "B").Value
wks.Cells(LastRow, "C").Value = ws.Cells(21, "B").Value
wks.Cells(LastRow, "D").Value = ws.Cells(20, "B").Value
wks.Cells(LastRow, "E").Value = ws.Cells(22, "B").Value
wks.Cells(LastRow, "F").Value = ws.Cells(23, "E").Value
wks.Cells(LastRow, "G").Value = ws.Cells(25, "B").Value

If blnOpened = True Then
wkb.Close SaveChanges:=True
End If
Call ToggleEvents(True)
End Sub

Re: macro to open existing file or create it if it does not exist

I appreciate the function, but once that check is complete i need it to either open the file, or create it.

Re: macro to open existing file or create it if it does not exist

Sub testcopyapptopc()

Dim wkb As Workbook, wks As Worksheet, LastRow As Long
Dim FilePath As String, FileName As String
Dim ws As Worksheet, blnOpened As Boolean
FilePath = "c:/"
FileName = "My Scheduled Appointments.xlsm"
Call Search ‘ I put this here thinking if I call it here, then it will create the new one and continue through the rest of the macro if needed or if it already has it I can &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;send it to a different macro to complete. it does call as it should, I thought this way it would go ahead and search it, if it exists I tried to tell the call search function to call the macro pc data which is just this macro without the call search option. Unfortunately its still telling me the file doesn’t exist. Its not creating it as I had hoped.
Call ToggleEvents(False)
Set ws = ThisWorkbook.Sheets("Call Center Template")
If WbOpen(FileName) = True Then
Set wkb = Workbooks(FileName)
blnOpened = False
Else
If Right(FilePath, 1) & Application.PathSeparator Then
FilePath = FilePath & Application.PathSeparator
End If
Set wkb = Workbooks.Open(FilePath & FileName")
blnOpened = True
End If
Set wks = wkb.Sheets("All Data")
LastRow = wks.Cells.Find(what:="*", after:=wks.Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
wks.Cells(LastRow, "A").Value = ws.Cells(19, "B").Value
wks.Cells(LastRow, "B").Value = ws.Cells(100, "B").Value
wks.Cells(LastRow, "C").Value = ws.Cells(21, "B").Value
wks.Cells(LastRow, "D").Value = ws.Cells(20, "B").Value
wks.Cells(LastRow, "E").Value = ws.Cells(22, "B").Value
wks.Cells(LastRow, "F").Value = ws.Cells(23, "E").Value
wks.Cells(LastRow, "G").Value = ws.Cells(25, "B").Value

If blnOpened = True Then
wkb.Close SaveChanges:=True
End If
Call ToggleEvents(True)
End Sub

Sub ToggleEvents(blnState As Boolean)
'Originally written by firefytr
With Application
.DisplayAlerts = blnState
.EnableEvents = blnState
.ScreenUpdating = blnState
If blnState Then .CutCopyMode = False
If blnState Then .StatusBar = False
End With
End Sub
Function WbOpen(wbName As String) As Boolean

End Function

Function Search()
Dim Newkbk As Workbook
fname = FilePath &amp; FileName
If Fileexists(fname) = True Then
Call pcaddon
Else
Set Newkbk = Workbooks.Add
Newkbk.SaveAs Fname
End If
End Function

Function Fileexists(fname) As Boolean
If Dir(fname) &lt;&gt; "" Then _ at this point it advises type mismatch
Fileexists = True _
Else Fileexists = False
End Function

this is how i set the macro up in my spreasheet, my comments are in bold, the underlined is where it is now erroring, please help me figure out what in my concept i am doing wrong, i greatly appreciate your help. Im attatching a dataless spreadsheet, the macro name is&nbsp;testcopyapptopc if it would help to look at it.&nbsp;forum.ozgrid.com/index.php?attachment/42581/

Re: macro to open existing file or create it if it does not exist

the macro name is "testcopyapptopc" if it would help to look at it

Re: macro to open existing file or create it if it does not exist

playing around with it, i have altered the line that was erroring to Function Fileexists(fname) As Boolean If fname = Dir("My Scheduled Appointments.xlsm") <> "" Then _
Fileexists = True _
Else Fileexists = False
End Function

now ti makes it it past that point, the problem is, it automatically is going to call "pcaddon" even if the file doesnt exist, so am I just breaking it worse? I'm sorry, normally I can work through these but this one seems to be besting me at this time.

Re: macro to open existing file or create it if it does not exist

Thank you so much, after some alterations to make all the macros work together its perfect!!

Dim wkb As Workbook, wks As Worksheet, LastRow As Long
    Dim FilePath As String, FileName As String
    Dim ws As Worksheet, blnOpened As Boolean
    Dim fname As String
    'Change these variables as desired...
    FilePath = "c:\" 'change path here
    FileName = "My Scheduled Appointments.xls" 'change name here
    fname = FilePath & FileName
    Call Search(fname)
    Call ToggleEvents(False)
    Set ws = ThisWorkbook.Sheets("Call Center Template") 'change source sheet name here
    If WbOpen(FileName) = True Then
        Set wkb = Workbooks(FileName)
        blnOpened = False
    Else
        If Right(FilePath, 1) <> Application.PathSeparator Then
            FilePath = FilePath & Application.PathSeparator
        End If
        Set wkb = Workbooks.Open(FilePath & FileName)
        blnOpened = True
    End If
    Set wks = wkb.Sheets("All Data") 'change destination sheet name here
    LastRow = wks.Cells.Find(what:="*", after:=wks.Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
    wks.Cells(LastRow, "A").Value = ws.Cells(19, "B").Value
    wks.Cells(LastRow, "B").Value = ws.Cells(100, "B").Value
    wks.Cells(LastRow, "C").Value = ws.Cells(21, "B").Value
    wks.Cells(LastRow, "D").Value = ws.Cells(20, "B").Value
    wks.Cells(LastRow, "E").Value = ws.Cells(22, "B").Value
    wks.Cells(LastRow, "F").Value = ws.Cells(23, "E").Value
    wks.Cells(LastRow, "G").Value = ws.Cells(25, "B").Value
    
    If blnOpened = True Then
        wkb.Close SaveChanges:=True
      End If
    Call ToggleEvents(True)
End Sub












Sub ToggleEvents(blnState As Boolean)
'Originally written by firefytr
    With Application
        .DisplayAlerts = blnState
        .EnableEvents = blnState
        .ScreenUpdating = blnState
        If blnState Then .CutCopyMode = False
        If blnState Then .StatusBar = False
    End With
End Sub
Function WbOpen(wbName As String) As Boolean




End Function




Function Search(fname)
    Dim Newkbk As Workbook
    If Fileexists(fname) = True Then
        Workbooks.Open fname
    Else
        Set Newkbk = Workbooks.Add
        Set wk = Sheets.Add
        wk.Name = "All Data"
        Sheets("All Data").Activate
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "Set By"
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "Consumer's Name"
        Range("C1").Select
        ActiveCell.FormulaR1C1 = "Urgency"
        Range("D1").Select
        ActiveCell.FormulaR1C1 = "Provider Selected"
        Range("E1").Select
        ActiveCell.FormulaR1C1 = "Appointment Date"
        Range("F1").Select
        ActiveCell.FormulaR1C1 = "Appointment Time"
        Range("G1").Select
        ActiveCell.FormulaR1C1 = "Address"
        Columns("A:G").Select
        Columns("A:G").EntireColumn.AutoFit
        Newkbk.SaveAs fname
        Newkbk.Close
    End If
End Function
 
 Function Fileexists(fname) As Boolean
    If Dir(fname) <> "" Then _
    Fileexists = True _
Else Fileexists = False
End Function