반응형

매크로 하다보면 작업자마다

폴더위치가 괴상망칙해지는 경우가 많아 파일하나에 위치를 지정했더니

각자 파일을 써야 되는 문제 발생

레지스트리에 써버리자...


Sub setxmlfolder() '함수이름 

Set wsh2 = CreateObject("WScript.Shell") '스크립트 쉘 하나 생성

On Error Resume Next

strRegValue2 = wsh.RegRead(strRegPath2) '해당 패스의 값을 읽어

If GetSetting(appname:="Exportxml", section:="folder", Key:="xmlfolder", Default:="0") <> 0 Then 'Err.Number <> 0 Then

'값 읽어오기 기본 패스는 "HKEY_CURRENT_USER\Software\VB and VBA Program Settings 하위에 Exportxml <- app name , folder<-section , xmlfolder <-key 

msgValue = MsgBox("현재 위치는" & GetSetting(appname:="Exportxml", section:="folder", Key:="xmlfolder", Default:="0") & "입니다." & vbCr & "바꾸려면 확인 그대로는 취소", vbOKCancel)

    If msgValue = 1 Then

'폴더위치 설정

        With Application.FileDialog(msoFileDialogFolderPicker) 

            .InitialFileName = Application.DefaultFilePath & "\"

            .Title = "변경위치를 설정해주세요"

            .Show

            If .SelectedItems.Count = 0 Then

                MsgBox "xml 익스포트 위치 설정 취소"

                ExitAll = True

            Else

                SaveSetting appname:="Exportxml", section:="folder", Key:="xmlfolder", setting:=.SelectedItems(1)

'폴더위치 저장


                MsgBox ("xml위치" & GetSetting(appname:="Exportxml", section:="folder", Key:="xmlfolder", Default:="25") & " 로 설정되었습니다")

                ExitAll = False

            End If

        End With

    Else: MsgBox "설정취소됨"

    ExitAll = True

    End If

Else

msgValue = MsgBox("익스포트 위치가 없습니다. 설정해주세요" & vbCr & "취소하면 익스포트 안됩니다.", vbOKCancel)

    If msgValue = 1 Then

        With Application.FileDialog(msoFileDialogFolderPicker)

            .InitialFileName = Application.DefaultFilePath & "\"

            .Title = "xml 위치가 없습니다 설정해주세요. 기본위치는 \dev\Config\APP\ 입니다"

            .Show

            If .SelectedItems.Count = 0 Then

                MsgBox "xml 익스포트 위치 설정 취소"

                ExitAll = True

            Else

                SaveSetting appname:="Exportxml", section:="folder", Key:="xmlfolder", setting:=.SelectedItems(1)

                MsgBox ("xml위치" & GetSetting(appname:="Exportxml", section:="folder", Key:="xmlfolder", Default:="25") & " 로 설정되었습니다")

                ExitAll = False

            End If

        End With

    Else: MsgBox "설정취소됨"

    ExitAll = True

    End If


End If

End Sub


음.....잘되네...뭐지...ㅋㅋㅋㅋ


반응형

+ Recent posts